R/f_core_assertions.R

Defines functions .isDelayedInformationEnabled .isAlphaSpendingDesign .assertIsValidPlannedSubjects .assertIsValidEffectMatrixSurvival .assertIsValidEffectMatrixRates .assertIsValidEffectMatrixMeans .assertIsValidTypeOfShape .assertIsValidDecisionMatrix .assertIsValidMatrix .assertIsValidEffectMeasure .assertIsValidSuccessCriterion .assertIsValidTypeOfSelection .isSpecialPlotShowSourceArgument .assertIsValidSummaryIntervalFormat .assertIsValidVarianceOptionEnrichment .isValidVarianceOptionEnrichment .assertIsValidVarianceOptionMultiArmed .isValidVarianceOptionMultiArmed .assertIsValidTolerance .stopInCaseOfIllegalStageDefinition2 .stopInCaseOfIllegalStageDefinition .ignoreParameterIfNotUsed .assertIsValidIntersectionTestEnrichment .isValidIntersectionTestEnrichment .assertIsValidIntersectionTestMultiArm .getCorrectedIntersectionTestMultiArmIfNecessary .isValidIntersectionTestMultiArm .assertIsAnalysisResults .assertIsDatasetNonMultiHypotheses .assertIsStageResultsNonMultiHypotheses .assertIsStageResultsMultiArm .isEnrichmentSimulationResults .isMultiArmSimulationResults .isEnrichmentAnalysisResults .isEnrichmentDataset .isMultiHypothesesAnalysisResults .isMultiArmAnalysisResults .isEnrichmentConditionalPowerResults .isEnrichmentStageResults .isMultiArmStageResults .isMultiArmDataset .assertIsOneSidedDesign .assertAreSuitableInformationRates .assertIsValidMaxNumberOfSubjects .assertIsValidNumberOfSubjectsPerStage .assertIsValidPlannedSubjectsOrEvents .assertIsValidThreshold .assertIsValidFunction .assertIsFunction .assertIsValidDirectionUpper .assertIsValidHazardRatioVector .assertIsValidHazardRatio .assertIsValidPiControlForEnrichment .assertIsValidPiTreatmentsForEnrichment .assertIsValidPiControlForMultiArm .assertIsValidPiTreatmentsForMultiArm .assertIsValidAssumedStDevs .assertIsValidAssumedStDevForMultiHypotheses .assertIsValidThetaH1ForEnrichment .assertIsValidThetaH1ForMultiArm .assertIsValidAssumedStDev .assertIsValidThetaH1 .assertIsValidAllocationRatioPlannedSampleSize .assertIsValidAllocationRatioPlanned .assertIsValidPi2 .assertIsValidPi1 .assertIsValidPi .assertIsValidPiTreatmentRange .assertIsValidThetaRange .assertIsValidThetaH0DataInput .assertIsValidThetaH0 .assertMnormtIsInstalled .assertTestthatIsInstalled .assertRcppIsInstalled .assertGgplotIsInstalled .assertPackageIsInstalled .isTrialDesignWithValidAlpha0Vec .isTrialDesignWithValidFutilityBounds .warnInCaseOfUnusedArgument .warnInCaseOfUnknownArguments .isValidNPlanned .assertIsValidNPlanned .associatedArgumentsAreDefined .assertAssociatedArgumentsAreDefined .allArgumentsAreNotNull .assertIsValidGroupsParameter .assertIsValidSidedParameter .assertIsValidAlpha0Vec .assertIsValidCipher .assertAreValidFutilityBounds .assertValuesAreMonotoneIncreasing .assertValuesAreStrictlyIncreasing .assertContainsOnlyNasAtTheEnd .assertContainsNoNas .assertValuesAreInsideBounds .assertAreValidInformationRates .assertIsValidKMax .assertIsValidLegendPosition .assertIsValidIterationsAndSeed .assertIsValidStage .assertIsValidAlphaAndBeta .assertIsValidBeta .assertIsValidStandardDeviation .assertIsValidAccrualTime .assertIsValidFollowUpTime .assertIsValidLambda .assertIsValidKappa .assertIsValidAlpha .assertIsOptimizationCriterion .designParameterExists .assertDesignParameterExists .assertIsCharacter .assertIsSingleCharacter .assertIsSinglePositiveInteger .assertIsSingleInteger .assertIsSingleNumber .assertIsSingleLogical .assertIsNoDefault .assertIsLogicalVector .assertIsIntegerVector .assertIsNumericVector .isDatasetSurvival .isDatasetRates .isDatasetMeans .isDataset .assertIsDatasetSurvival .assertIsDatasetRates .assertIsDatasetMeans .assertIsDataset .assertIsValidDataInput .assertIsInOpenInterval .assertIsInClosedInterval .assertIsStageResults .isStageResultsEnrichmentSurvival .isStageResultsEnrichmentMeans .isStageResultsMultiArmSurvival .isStageResultsMultiArmMeans .isStageResults .assertIsSimulationResults .isSimulationResults .assertIsTrialDesignInverseNormalOrFisherOrConditionalDunnett .assertIsTrialDesignInverseNormalOrFisher .assertIsTrialDesignInverseNormalOrGroupSequential .assertIsTrialDesignConditionalDunnett .assertIsTrialDesignGroupSequential .assertIsTrialDesignFisher .assertIsTrialDesignInverseNormal .assertIsTrialDesign .assertIsTrialDesignPlan .isTrialDesignPlan .isTrialDesignPlanSurvival .isTrialDesignPlanRates .isTrialDesignPlanMeans .isTrialDesign .isTrialDesignInverseNormalOrFisher .isTrialDesignInverseNormalOrGroupSequential .isTrialDesignConditionalDunnett .isTrialDesignFisher .isTrialDesignInverseNormal .isTrialDesignGroupSequential .isTrialDesignSet .assertIsTrialDesignSet .assertIsParameterSetClass .isParameterSet .stopWithWrongDesignMessageEnrichment .stopWithWrongDesignMessage

## |
## |  *Core assertions*
## |
## |  This file is part of the R package rpact:
## |  Confirmatory Adaptive Clinical Trial Design and Analysis
## |
## |  Author: Gernot Wassmer, PhD, and Friedrich Pahlke, PhD
## |  Licensed under "GNU Lesser General Public License" version 3
## |  License text can be found here: https://www.r-project.org/Licenses/LGPL-3
## |
## |  RPACT company website: https://www.rpact.com
## |  rpact package website: https://www.rpact.org
## |
## |  Contact us for information about our services: info@rpact.com
## |
## |  File version: $Revision: 7126 $
## |  Last changed: $Date: 2023-06-23 14:26:39 +0200 (Fr, 23 Jun 2023) $
## |  Last changed by: $Author: pahlke $
## |

#' @include f_core_utilities.R
NULL

.stopWithWrongDesignMessage <- function(design, ..., inclusiveConditionalDunnett = TRUE) {
    stop(C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "'design' must be an instance of ", .arrayToString(
        .getTrialDesignClassNames(inclusiveConditionalDunnett = inclusiveConditionalDunnett),
        vectorLookAndFeelEnabled = FALSE
    ), " (is '", .getClassName(design), "')")
}

.stopWithWrongDesignMessageEnrichment <- function(design, ..., inclusiveConditionalDunnett = TRUE) {
    trialDesignClassNames <- c(C_CLASS_NAME_TRIAL_DESIGN_INVERSE_NORMAL, C_CLASS_NAME_TRIAL_DESIGN_FISHER)
    stop(C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "'design' must be an instance of ", .arrayToString(
        trialDesignClassNames,
        vectorLookAndFeelEnabled = FALSE
    ), " (is '", .getClassName(design), "')")
}

.isParameterSet <- function(x) {
    return(isS4(x) && inherits(x, "ParameterSet"))
}

.assertIsParameterSetClass <- function(x, objectName = "x") {
    if (!.isParameterSet(x)) {
        stop(
            C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT,
            "'", objectName, "' (", .getClassName(x), ") must be a S4 class which inherits from class 'ParameterSet' "
        )
    }
}

.assertIsTrialDesignSet <- function(x, objectName = "x") {
    if (!.isTrialDesignSet(x)) {
        stop(
            C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT,
            "'designSet' must be an instance of 'TrialDesignSet' (is '", .getClassName(x), "')"
        )
    }
}

.isTrialDesignSet <- function(x) {
    return(.getClassName(x) == "TrialDesignSet")
}

.isTrialDesignGroupSequential <- function(design) {
    return(.getClassName(design) == C_CLASS_NAME_TRIAL_DESIGN_GROUP_SEQUENTIAL)
}

.isTrialDesignInverseNormal <- function(design) {
    return(.getClassName(design) == C_CLASS_NAME_TRIAL_DESIGN_INVERSE_NORMAL)
}

.isTrialDesignFisher <- function(design) {
    return(.getClassName(design) == C_CLASS_NAME_TRIAL_DESIGN_FISHER)
}

.isTrialDesignConditionalDunnett <- function(design) {
    return(.getClassName(design) == C_CLASS_NAME_TRIAL_DESIGN_CONDITIONAL_DUNNETT)
}

.isTrialDesignInverseNormalOrGroupSequential <- function(design) {
    return(.isTrialDesignInverseNormal(design) || .isTrialDesignGroupSequential(design))
}

.isTrialDesignInverseNormalOrFisher <- function(design) {
    return(.isTrialDesignInverseNormal(design) || .isTrialDesignFisher(design))
}

.isTrialDesign <- function(design) {
    return(.isTrialDesignInverseNormal(design) || .isTrialDesignGroupSequential(design) ||
        .isTrialDesignFisher(design) || .isTrialDesignConditionalDunnett(design))
}

.isTrialDesignPlanMeans <- function(designPlan) {
    return(.getClassName(designPlan) == "TrialDesignPlanMeans")
}

.isTrialDesignPlanRates <- function(designPlan) {
    return(.getClassName(designPlan) == "TrialDesignPlanRates")
}

.isTrialDesignPlanSurvival <- function(designPlan) {
    return(.getClassName(designPlan) == "TrialDesignPlanSurvival")
}

.isTrialDesignPlan <- function(designPlan) {
    return(.isTrialDesignPlanMeans(designPlan) ||
        .isTrialDesignPlanRates(designPlan) ||
        .isTrialDesignPlanSurvival(designPlan))
}

.assertIsTrialDesignPlan <- function(designPlan) {
    if (!.isTrialDesignPlan(designPlan)) {
        stop(
            C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT,
            "'designPlan' must be an instance of 'TrialDesignPlan' (is '", .getClassName(designPlan), "')"
        )
    }
}

.assertIsTrialDesign <- function(design) {
    if (!.isTrialDesign(design)) {
        stop(C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "'design' must be an instance of ", .arrayToString(
            .getTrialDesignClassNames(),
            vectorLookAndFeelEnabled = FALSE
        ), " (is '", .getClassName(design), "')")
    }
}

.assertIsTrialDesignInverseNormal <- function(design) {
    if (!.isTrialDesignInverseNormal(design)) {
        stop(
            C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT,
            "'design' must be an instance of class 'TrialDesignInverseNormal' (is '", .getClassName(design), "')"
        )
    }
}

.assertIsTrialDesignFisher <- function(design) {
    if (!.isTrialDesignFisher(design)) {
        stop(
            C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT,
            "'design' must be an instance of class 'TrialDesignFisher' (is '", .getClassName(design), "')"
        )
    }
}

.assertIsTrialDesignGroupSequential <- function(design) {
    if (!.isTrialDesignGroupSequential(design)) {
        stop(
            C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT,
            "'design' must be an instance of class 'TrialDesignGroupSequential' (is '", .getClassName(design), "')"
        )
    }
}

.assertIsTrialDesignConditionalDunnett <- function(design) {
    if (!.isTrialDesignConditionalDunnett(design)) {
        stop(
            C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT,
            "'design' must be an instance of class 'TrialDesignConditionalDunnett' (is '", .getClassName(design), "')"
        )
    }
}

.assertIsTrialDesignInverseNormalOrGroupSequential <- function(design) {
    if (!.isTrialDesignInverseNormalOrGroupSequential(design)) {
        stop(
            C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT,
            "'design' must be an instance of class 'TrialDesignInverseNormal' or 'TrialDesignGroupSequential' (is '",
            .getClassName(design), "')"
        )
    }
}

.assertIsTrialDesignInverseNormalOrFisher <- function(design) {
    if (!.isTrialDesignInverseNormalOrFisher(design)) {
        stop(
            C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT,
            "'design' must be an instance of class 'TrialDesignInverseNormal' or 'TrialDesignFisher' (is '",
            .getClassName(design), "')"
        )
    }
}

.assertIsTrialDesignInverseNormalOrFisherOrConditionalDunnett <- function(design) {
    if (!.isTrialDesignInverseNormalOrFisher(design) && !.isTrialDesignConditionalDunnett(design)) {
        stop(
            C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT,
            "'design' must be an instance of class 'TrialDesignInverseNormal', ",
            "'TrialDesignFisher', or 'TrialDesignConditionalDunnett' (is '",
            .getClassName(design), "')"
        )
    }
}

.isSimulationResults <- function(simulationResults) {
    return(inherits(simulationResults, "SimulationResults"))
}

.assertIsSimulationResults <- function(simulationResults) {
    if (!.isSimulationResults(simulationResults)) {
        stop(
            C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT,
            "'simulationResults' must be an instance of SimulationResults (is '", .getClassName(simulationResults), "')"
        )
    }
}

.isStageResults <- function(stageResults) {
    return(inherits(stageResults, "StageResults"))
}

.isStageResultsMultiArmMeans <- function(stageResults) {
    return(.getClassName(stageResults) == "StageResultsMultiArmMeans")
}

.isStageResultsMultiArmSurvival <- function(stageResults) {
    return(.getClassName(stageResults) == "StageResultsMultiArmSurvival")
}

.isStageResultsEnrichmentMeans <- function(stageResults) {
    return(.getClassName(stageResults) == "StageResultsEnrichmentMeans")
}

.isStageResultsEnrichmentSurvival <- function(stageResults) {
    return(.getClassName(stageResults) == "StageResultsEnrichmentSurvival")
}

.assertIsStageResults <- function(stageResults) {
    if (!.isStageResults(stageResults)) {
        stop(
            C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "'stageResults' must be a 'StageResults' object",
            " (is '", .getClassName(stageResults), "')"
        )
    }
}

.assertIsInClosedInterval <- function(x, xName, ..., lower, upper, naAllowed = FALSE, call. = TRUE) {
    .warnInCaseOfUnknownArguments(functionName = ".assertIsInClosedInterval", ...)
    if (naAllowed && all(is.na(x))) {
        return(invisible())
    }

    if (!naAllowed && length(x) > 1 && any(is.na(x))) {
        stop(
            C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT,
            "'", xName, "' (", .arrayToString(x), ") must be a valid numeric vector or a single NA",
            call. = call.
        )
    }

    if (is.null(upper) || is.na(upper)) {
        if (any(x < lower, na.rm = TRUE)) {
            prefix <- ifelse(length(x) > 1, "each value of ", "")
            stop(
                C_EXCEPTION_TYPE_ARGUMENT_OUT_OF_BOUNDS, prefix,
                "'", xName, "' (", .arrayToString(x), ") must be >= ", lower,
                call. = call.
            )
        }
    } else if (any(x < lower, na.rm = TRUE) || any(x > upper, na.rm = TRUE)) {
        stop(
            C_EXCEPTION_TYPE_ARGUMENT_OUT_OF_BOUNDS,
            "'", xName, "' (", .arrayToString(x), ") is out of bounds [", lower, "; ", upper, "]",
            call. = call.
        )
    }
}

.assertIsInOpenInterval <- function(x, xName, lower, upper, naAllowed = FALSE, call. = TRUE) {
    if (naAllowed && all(is.na(x))) {
        return(invisible())
    }

    if (!naAllowed && length(x) > 1 && any(is.na(x))) {
        stop(
            C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT,
            "'", xName, "' (", .arrayToString(x), ") must be a valid numeric vector or a single NA"
        )
    }

    if (is.null(upper) || is.na(upper)) {
        if (any(x <= lower, na.rm = TRUE)) {
            prefix <- ifelse(length(x) > 1, "each value of ", "")
            stop(
                C_EXCEPTION_TYPE_ARGUMENT_OUT_OF_BOUNDS, prefix,
                "'", xName, "' (", .arrayToString(x), ") must be > ", lower,
                call. = call.
            )
        }
    } else if (any(x <= lower, na.rm = TRUE) || any(x >= upper, na.rm = TRUE)) {
        stop(
            C_EXCEPTION_TYPE_ARGUMENT_OUT_OF_BOUNDS,
            "'", xName, "' (", .arrayToString(x), ") is out of bounds (", lower, "; ", upper, ")",
            call. = call.
        )
    }
}

.assertIsValidDataInput <- function(dataInput, design = NULL, stage = NULL) {
    .assertIsDataset(dataInput)
    if (!is.null(design)) {
        .assertIsTrialDesign(design)
    }

    if (dataInput$.enrichmentEnabled && dataInput$getNumberOfGroups() != 2) {
        stop(
            C_EXCEPTION_TYPE_ILLEGAL_DATA_INPUT,
            "only population enrichment data with 2 groups can be analyzed but ",
            dataInput$getNumberOfGroups(), " group",
            ifelse(dataInput$getNumberOfGroups() == 1, " is", "s are"), " defined"
        )
    }

    stages <- dataInput$stages
    l1 <- length(stages)
    for (fieldName in dataInput$.getVisibleFieldNames()) {
        l2 <- length(dataInput[[fieldName]])
        if (fieldName != "stages" && l1 != l2) {
            stop(
                C_EXCEPTION_TYPE_ILLEGAL_DATA_INPUT,
                "all parameters must have the same length ('stages' has length ", l1,
                ", '", fieldName, "' has length ", l2, ")"
            )
        }
    }

    if (!is.null(stage)) {
        if (dataInput$getNumberOfGroups() == 1) {
            if (.isDatasetMeans(dataInput)) {
                if (any(na.omit(dataInput$getStDevsUpTo(stage)) <= 0)) {
                    stop(C_EXCEPTION_TYPE_ILLEGAL_DATA_INPUT, "all standard deviations must be > 0")
                }
                if (any(na.omit(dataInput$getSampleSizesUpTo(stage)) <= 0)) {
                    stop(C_EXCEPTION_TYPE_ILLEGAL_DATA_INPUT, "all sample sizes must be > 0")
                }
            } else if (.isDatasetRates(dataInput)) {
                if (any(na.omit(dataInput$getEventsUpTo(stage)) < 0)) {
                    stop(C_EXCEPTION_TYPE_ILLEGAL_DATA_INPUT, "all events must be >= 0")
                }
                if (any(na.omit(dataInput$getSampleSizesUpTo(stage)) <= 0)) {
                    stop(C_EXCEPTION_TYPE_ILLEGAL_DATA_INPUT, "all sample sizes must be > 0")
                }
                if (any(na.omit(dataInput$getEventsUpTo(stage)) > na.omit(dataInput$getSampleSizesUpTo(stage)))) {
                    stop(C_EXCEPTION_TYPE_ILLEGAL_DATA_INPUT, "all events must be <= corresponding sample size")
                }
            }
        } else if (dataInput$getNumberOfGroups() == 2) {
            if (.isDatasetMeans(dataInput)) {
                if (any(na.omit(dataInput$getStDevsUpTo(stage, 1)) <= 0) ||
                        any(na.omit(dataInput$getStDevsUpTo(stage, 2)) <= 0)) {
                    stop(C_EXCEPTION_TYPE_ILLEGAL_DATA_INPUT, "all standard deviations must be > 0")
                }
                if (any(na.omit(dataInput$getSampleSizesUpTo(stage, 1)) <= 0) ||
                        any(na.omit(dataInput$getSampleSizesUpTo(stage, 2)) <= 0)) {
                    stop(C_EXCEPTION_TYPE_ILLEGAL_DATA_INPUT, "all sample sizes must be > 0")
                }
            } else if (.isDatasetRates(dataInput)) {
                if (any(na.omit(dataInput$getEventsUpTo(stage, 1)) < 0) ||
                        any(na.omit(dataInput$getEventsUpTo(stage, 2)) < 0)) {
                    stop(C_EXCEPTION_TYPE_ILLEGAL_DATA_INPUT, "all events must be >= 0")
                }
                if (any(na.omit(dataInput$getSampleSizesUpTo(stage, 1)) <= 0) ||
                        any(na.omit(dataInput$getSampleSizesUpTo(stage, 2)) <= 0)) {
                    stop(C_EXCEPTION_TYPE_ILLEGAL_DATA_INPUT, "all sample sizes must be > 0")
                }
                if (any(na.omit(dataInput$getEventsUpTo(stage, 1)) > na.omit(dataInput$getSampleSizesUpTo(stage, 1))) ||
                        any(na.omit(dataInput$getEventsUpTo(stage, 2)) > na.omit(dataInput$getSampleSizesUpTo(stage, 2)))) {
                    stop(C_EXCEPTION_TYPE_ILLEGAL_DATA_INPUT, "all events must be <= corresponding sample size")
                }
            }
        }

        if (.isDatasetSurvival(dataInput)) {
            if (any(na.omit(dataInput$getOverallEventsUpTo(stage)) < 0)) {
                stop(C_EXCEPTION_TYPE_ILLEGAL_DATA_INPUT, "all cumulative events must be >= 0")
            }

            if (any(na.omit(dataInput$getOverallAllocationRatiosUpTo(stage)) <= 0)) {
                stop(C_EXCEPTION_TYPE_ILLEGAL_DATA_INPUT, "all cumulative allocation ratios must be > 0")
            }
        }
    }

    if (!is.null(design)) {
        numberOfStages <- length(unique(stats::na.omit(stages)))
        kMax <- design$kMax
        if (numberOfStages > kMax) {
            s <- numberOfStages - kMax
            plural <- ifelse(s == 1, "", "s")
            warning(sprintf(
                paste0(
                    "The data of the last %s in the dataset will be ",
                    "ignored because the design has specified kMax = %s"
                ),
                ifelse(s == 1, "stage", paste0(s, " stages")), kMax
            ), call. = FALSE)
        } else if (numberOfStages < kMax) {
            dataInput$.fillWithNAs(kMax)
        }
    }

    invisible(dataInput)
}

.assertIsDataset <- function(dataInput) {
    if (!.isDataset(dataInput)) {
        stop(
            C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "'dataInput' must be an instance of class ",
            "'DatasetMeans', 'DatasetRates' or 'DatasetSurvival' (is '", .getClassName(dataInput), "')"
        )
    }
}

.assertIsDatasetMeans <- function(dataInput) {
    if (!.isDatasetMeans(dataInput = dataInput)) {
        stop(
            C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "'dataInput' must be an instance of class ",
            "'DatasetMeans' (is '", .getClassName(dataInput), "')"
        )
    }
}

.assertIsDatasetRates <- function(dataInput) {
    if (!.isDatasetRates(dataInput = dataInput)) {
        stop(
            C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "'dataInput' must be an instance of class ",
            "'DatasetRates' (is '", .getClassName(dataInput), "')"
        )
    }
}

.assertIsDatasetSurvival <- function(dataInput) {
    if (!.isDatasetSurvival(dataInput = dataInput)) {
        stop(
            C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "'dataInput' must be an instance of class ",
            "'DatasetSurvival' or 'DatasetEnrichmentSurvival' (is '", .getClassName(dataInput), "')"
        )
    }
}

.isDataset <- function(dataInput) {
    return(.isDatasetMeans(dataInput) || .isDatasetRates(dataInput) || .isDatasetSurvival(dataInput))
}

.isDatasetMeans <- function(dataInput) {
    return(inherits(dataInput, "DatasetMeans"))
}

.isDatasetRates <- function(dataInput) {
    return(inherits(dataInput, "DatasetRates"))
}

.isDatasetSurvival <- function(dataInput) {
    return(inherits(dataInput, "DatasetSurvival") || inherits(dataInput, "DatasetEnrichmentSurvival"))
}

.assertIsNumericVector <- function(x, argumentName, ..., naAllowed = FALSE, noDefaultAvailable = FALSE, call. = TRUE) {
    if (missing(x) || is.null(x) || length(x) == 0) {
        .assertIsNoDefault(x, argumentName, noDefaultAvailable, checkNA = FALSE)
        stop(
            C_EXCEPTION_TYPE_MISSING_ARGUMENT, "'", argumentName,
            "' must be a valid numeric value or vector",
            call. = call.
        )
    }

    .assertIsNoDefault(x, argumentName, noDefaultAvailable, checkNA = TRUE)

    if ((!naAllowed && any(is.na(x))) || !is.numeric(x)) {
        stop(
            C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "'", argumentName, "' (",
            .arrayToString(x), ") must be a valid numeric value or vector",
            call. = call.
        )
    }
}

.assertIsIntegerVector <- function(x, argumentName, ..., naAllowed = FALSE,
        validateType = TRUE, noDefaultAvailable = FALSE, call. = TRUE) {
    if (missing(x) || is.null(x) || length(x) == 0) {
        .assertIsNoDefault(x, argumentName, noDefaultAvailable, checkNA = FALSE)
        stop(
            C_EXCEPTION_TYPE_MISSING_ARGUMENT, "'", argumentName,
            "' must be a valid integer value or vector",
            call. = call.
        )
    }

    .assertIsNoDefault(x, argumentName, noDefaultAvailable, checkNA = TRUE)

    if (naAllowed && all(is.na(x))) {
        return(invisible())
    }

    if (!is.numeric(x) || (!naAllowed && any(is.na(x))) || (validateType && !is.integer(x)) ||
            (!validateType && any(as.integer(na.omit(x)) != na.omit(x)))) {
        stop(
            C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "'", argumentName, "' (",
            .arrayToString(x), ") must be a valid integer value or vector",
            call. = call.
        )
    }
}

.assertIsLogicalVector <- function(x, argumentName, ..., naAllowed = FALSE,
        noDefaultAvailable = FALSE, call. = TRUE) {
    if (missing(x) || is.null(x) || length(x) == 0) {
        .assertIsNoDefault(x, argumentName, noDefaultAvailable, checkNA = FALSE)
        stop(C_EXCEPTION_TYPE_MISSING_ARGUMENT, "'", argumentName, "' ",
            "must be a valid logical value or vector",
            call. = call.
        )
    }

    .assertIsNoDefault(x, argumentName, noDefaultAvailable, checkNA = TRUE)

    if ((!naAllowed && all(is.na(x))) || !is.logical(x)) {
        stop(C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "'", argumentName, "' (", x, ") ",
            "must be a valid logical value or vector",
            call. = call.
        )
    }
}

.assertIsNoDefault <- function(x, argumentName, noDefaultAvailable, ..., checkNA = FALSE, call. = TRUE) {
    if (noDefaultAvailable && (!checkNA || all(is.na(x)))) {
        stop(C_EXCEPTION_TYPE_MISSING_ARGUMENT, "'", argumentName, "' ",
            "must be specified, there is no default value",
            call. = call.
        )
    }
}

.assertIsSingleLogical <- function(x, argumentName, ..., naAllowed = FALSE, noDefaultAvailable = FALSE, call. = TRUE) {
    if (missing(x) || is.null(x) || length(x) == 0) {
        .assertIsNoDefault(x, argumentName, noDefaultAvailable, checkNA = FALSE)
        stop(C_EXCEPTION_TYPE_MISSING_ARGUMENT, "'", argumentName, "' must be a single logical value",
            call. = call.
        )
    }

    .assertIsNoDefault(x, argumentName, noDefaultAvailable, checkNA = TRUE)

    if (length(x) > 1) {
        stop(
            C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "'", argumentName, "' ",
            .arrayToString(x, vectorLookAndFeelEnabled = TRUE), " must be a single logical value",
            call. = call.
        )
    }

    if ((!naAllowed && is.na(x)) || !is.logical(x)) {
        stop(
            C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "'", argumentName, "' (",
            ifelse(isS4(x), .getClassName(x), x), ") must be a single logical value",
            call. = call.
        )
    }
}

.assertIsSingleNumber <- function(x, argumentName, ..., naAllowed = FALSE, noDefaultAvailable = FALSE, call. = TRUE) {
    if (missing(x) || is.null(x) || length(x) == 0) {
        .assertIsNoDefault(x, argumentName, noDefaultAvailable, checkNA = FALSE)
        stop(C_EXCEPTION_TYPE_MISSING_ARGUMENT, "'", argumentName, "' must be a valid numeric value",
            call. = call.
        )
    }

    .assertIsNoDefault(x, argumentName, noDefaultAvailable, checkNA = TRUE)

    if (length(x) > 1) {
        stop(
            C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "'", argumentName, "' ",
            .arrayToString(x, vectorLookAndFeelEnabled = TRUE), " must be a single numeric value",
            call. = call.
        )
    }

    if ((!naAllowed && is.na(x)) || !is.numeric(x)) {
        stop(
            C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "'", argumentName, "' (",
            ifelse(isS4(x), .getClassName(x), x), ") must be a valid numeric value",
            call. = call.
        )
    }
}

.assertIsSingleInteger <- function(x, argumentName, ..., naAllowed = FALSE,
        validateType = TRUE, noDefaultAvailable = FALSE, call. = TRUE) {
    .assertIsSinglePositiveInteger(
        x = x, argumentName = argumentName,
        naAllowed = naAllowed, validateType = validateType,
        mustBePositive = FALSE, noDefaultAvailable = noDefaultAvailable,
        call. = call.
    )
}

.assertIsSinglePositiveInteger <- function(x, argumentName, ...,
        naAllowed = FALSE, validateType = TRUE, mustBePositive = TRUE, noDefaultAvailable = FALSE, call. = TRUE) {
    prefix <- ifelse(mustBePositive, "single positive ", "single ")
    if (missing(x) || is.null(x) || length(x) == 0) {
        .assertIsNoDefault(x, argumentName, noDefaultAvailable, checkNA = FALSE)
        stop(
            C_EXCEPTION_TYPE_MISSING_ARGUMENT,
            "'", argumentName, "' must be a ", prefix, "integer value",
            call. = call.
        )
    }

    .assertIsNoDefault(x, argumentName, noDefaultAvailable, checkNA = TRUE)

    if (length(x) > 1) {
        stop(
            C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "'", argumentName, "' ",
            .arrayToString(x, vectorLookAndFeelEnabled = TRUE),
            " must be a ", prefix, "integer value",
            call. = call.
        )
    }

    if (!is.numeric(x) || (!naAllowed && is.na(x)) || (validateType && !is.integer(x)) ||
            (!validateType && !is.na(x) && !is.infinite(x) && as.integer(x) != x)) {
        stop(
            C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT,
            "'", argumentName, "' (", ifelse(isS4(x), .getClassName(x), x), ") must be a ", prefix, "integer value",
            call. = call.
        )
    }

    if (mustBePositive && !is.na(x) && !is.infinite(x) && x <= 0) {
        stop(
            C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT,
            "'", argumentName, "' (", ifelse(isS4(x), .getClassName(x), x), ") must be a ", prefix, "integer value",
            call. = call.
        )
    }
}

.assertIsSingleCharacter <- function(x, argumentName, ..., naAllowed = FALSE, noDefaultAvailable = FALSE, call. = TRUE) {
    if (missing(x) || is.null(x) || length(x) == 0) {
        .assertIsNoDefault(x, argumentName, noDefaultAvailable, checkNA = FALSE)
        stop(C_EXCEPTION_TYPE_MISSING_ARGUMENT, "'", argumentName, "' must be a valid character value",
            call. = call.
        )
    }

    .assertIsNoDefault(x, argumentName, noDefaultAvailable, checkNA = TRUE)

    if (length(x) > 1) {
        stop(
            C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "'", argumentName, "' ",
            .arrayToString(x, vectorLookAndFeelEnabled = TRUE), " must be a single character value",
            call. = call.
        )
    }

    if (!is.character(x)) {
        stop(
            sprintf(paste0(
                C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT,
                "'%s' must be a valid character value (is an instance of class '%s')"
            ), argumentName, .getClassName(x)),
            call. = call.
        )
    }

    if (!naAllowed && is.na(x)) {
        stop(
            sprintf(paste0(
                C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT,
                "'%s' (NA) must be a valid character value"
            ), argumentName),
            call. = call.
        )
    }
}

.assertIsCharacter <- function(x, argumentName, ..., naAllowed = FALSE, call. = TRUE) {
    if (missing(x) || is.null(x) || length(x) == 0) {
        stop(
            C_EXCEPTION_TYPE_MISSING_ARGUMENT,
            "'", argumentName, "' must be a valid character value or vector",
            call. = call.
        )
    }

    if (!all(is.character(x))) {
        stop(
            sprintf(paste0(
                C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT,
                "'%s' must be a valid character value or vector ",
                "(is an instance of class '%s')"
            ), argumentName, .getClassName(x)),
            call. = call.
        )
    }

    if (!naAllowed && any(is.na(x))) {
        stop(
            sprintf(
                paste0(
                    C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT,
                    "'%s' (%s) must be a valid character value (NA is not allowed)"
                ),
                argumentName, .arrayToString(x)
            ),
            call. = call.
        )
    }
}

.assertDesignParameterExists <- function(design, parameterName, defaultValue) {
    if (missing(design)) {
        stop(C_EXCEPTION_TYPE_MISSING_ARGUMENT, "'design' must be defined")
    }

    if (missing(parameterName)) {
        stop(C_EXCEPTION_TYPE_MISSING_ARGUMENT, "'parameterName' must be defined")
    }

    if (missing(defaultValue)) {
        stop(C_EXCEPTION_TYPE_MISSING_ARGUMENT, "'defaultValue' must be defined")
    }

    value <- design[[parameterName]]
    if (is.null(value) || length(value) == 0 || all(is.na(value))) {
        stop(
            C_EXCEPTION_TYPE_MISSING_ARGUMENT, "parameter '", parameterName,
            "' must be specified in design"
        )
    }

    if (is.null(defaultValue) || length(defaultValue) == 0 || all(is.na(defaultValue))) {
        design$.setParameterType(parameterName, C_PARAM_USER_DEFINED)
        return(invisible())
    }

    if (all(value == defaultValue)) {
        design$.setParameterType(parameterName, C_PARAM_DEFAULT_VALUE)
    } else {
        design$.setParameterType(parameterName, C_PARAM_USER_DEFINED)
    }
}

.designParameterExists <- function(design, parameterName) {
    if (missing(design)) {
        stop(C_EXCEPTION_TYPE_MISSING_ARGUMENT, "'design' must be defined")
    }

    if (missing(parameterName)) {
        stop(C_EXCEPTION_TYPE_MISSING_ARGUMENT, "'parameterName' must be defined")
    }

    value <- design[[parameterName]]
    if (is.null(value)) {
        return(FALSE)
    }

    if (length(value) > 1) {
        return(sum(is.na(value)) < length(value))
    }

    return(!is.na(value))
}

.assertIsOptimizationCriterion <- function(x) {
    if (!.isOptimizationCriterion(x)) {
        stop(
            C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT,
            "optimization criterion must be one of the following: ", .printOptimizationCriterion()
        )
    }
}

.assertIsValidAlpha <- function(alpha) {
    .assertIsSingleNumber(alpha, "alpha")

    if (alpha < 1e-06 || alpha >= 0.5) {
        stop(
            C_EXCEPTION_TYPE_ARGUMENT_OUT_OF_BOUNDS,
            "'alpha' (", alpha, ") is out of bounds [1e-06; 0.5)"
        )
    }
}

.assertIsValidKappa <- function(kappa) {
    .assertIsSingleNumber(kappa, "kappa")
    .assertIsInOpenInterval(kappa, "kappa", lower = 0, upper = NULL)
}

.assertIsValidLambda <- function(lambda, lambdaNumber = 0) {
    argumentName <- "lambda"
    if (lambdaNumber >= 1) {
        argumentName <- paste0("lambda", lambdaNumber)
    }
    .assertIsNumericVector(lambda, argumentName, naAllowed = TRUE)
    if (all(is.na(lambda))) {
        return(invisible())
    }

    if (any(is.na(lambda))) {
        stop(
            C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "'", argumentName, "' (",
            .arrayToString(lambda), ") must be a valid numeric vector"
        )
    }

    .assertIsInClosedInterval(lambda, argumentName, lower = 0, upper = NULL)
    if (all(lambda == 0)) {
        stop(
            C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "'", argumentName, "' (",
            .arrayToString(lambda), ") not allowed: ",
            "at least one lambda value must be > 0"
        )
    }
}

.assertIsValidFollowUpTime <- function(followUpTime) {
    if (is.null(followUpTime) || length(followUpTime) == 0 || is.na(followUpTime)) {
        return(invisible())
    }

    .assertIsSingleNumber(followUpTime, "followUpTime", naAllowed = TRUE)
    if (followUpTime < 0) {
        stop(C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "'followUpTime' (", followUpTime, ") must be >= 0")
    }
}

.assertIsValidAccrualTime <- function(accrualTime) {
    .assertIsNumericVector(accrualTime, "accrualTime", naAllowed = TRUE)

    if (is.null(accrualTime) || length(accrualTime) == 0 || all(is.na(accrualTime))) {
        return(invisible())
    }

    if (any(accrualTime < 0)) {
        stop(
            C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "'accrualTime' (",
            .arrayToString(accrualTime), ") must be >= 0"
        )
    }
}

.assertIsValidStandardDeviation <- function(stDev) {
    .assertIsSingleNumber(stDev, "stDev")

    if (stDev <= 0) {
        stop(C_EXCEPTION_TYPE_ARGUMENT_OUT_OF_BOUNDS, "standard deviation 'stDev' (", stDev, ") must be > 0")
    }
}

.assertIsValidBeta <- function(beta, alpha) {
    .assertIsSingleNumber(beta, "beta")
    .assertIsSingleNumber(alpha, "alpha")

    if (beta < 1e-04 || beta >= 1 - alpha) {
        stop(
            C_EXCEPTION_TYPE_ARGUMENT_OUT_OF_BOUNDS,
            "'beta' (", beta, ") is out of bounds [1e-04; ", (1 - alpha), "); ",
            "condition: 1e-05 <= alpha < 1 - beta <= 1 - 1e-04"
        )
    }
}

.assertIsValidAlphaAndBeta <- function(alpha, beta) {
    .assertIsValidAlpha(alpha)
    .assertIsValidBeta(beta, alpha)
}

.assertIsValidStage <- function(stage, kMax) {
    if (stage < 1 || stage > kMax) {
        stop(
            C_EXCEPTION_TYPE_ARGUMENT_OUT_OF_BOUNDS,
            "'stage' (", stage, ") is out of bounds [1; ", kMax, "]"
        )
    }
}

.assertIsValidIterationsAndSeed <- function(iterations, seed, ..., zeroIterationsAllowed = TRUE) {
    if (is.null(iterations) || length(iterations) == 0 || !is.numeric(iterations)) {
        stop(
            C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT,
            "'iterations' must be a valid integer value"
        )
    }

    if (zeroIterationsAllowed) {
        if (iterations < 0) {
            stop(
                C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT,
                "'iterations' (", iterations, ") must be >= 0"
            )
        }
    } else {
        if (iterations < 1) {
            stop(
                C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT,
                "'iterations' (", iterations, ") must be > 0"
            )
        }
    }

    if (is.null(seed) || length(seed) == 0 || (!is.na(seed) && !is.numeric(seed))) {
        stop(
            C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT,
            "'seed' (", seed, ") must be a valid integer value"
        )
    }
}

.assertIsValidLegendPosition <- function(legendPosition) {
    if (is.null(legendPosition) || length(legendPosition) != 1) {
        stop(
            C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT,
            "'legendPosition' (", .arrayToString(legendPosition), ") must be a single integer or character value"
        )
    }

    if (is.na(legendPosition)) {
        return(invisible())
    }

    if (!is.numeric(legendPosition) && !is.character(legendPosition)) {
        stop(
            C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT,
            "'legendPosition' (", legendPosition, ") must be a single integer or character value"
        )
    }

    if (is.numeric(legendPosition)) {
        .assertIsSingleInteger(legendPosition, "legendPosition", validateType = FALSE)
        .assertIsInClosedInterval(legendPosition, "legendPosition", lower = -1, upper = 6)
    } else {
        validLegendPositions <- c("none", "top", "bottom", "left", "right")
        if (!(legendPosition %in% validLegendPositions)) {
            stop(
                C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT,
                "'legendPosition' (", legendPosition, ") must be one of the following values: ",
                .arrayToString(validLegendPositions)
            )
        }
    }
}

.assertIsValidKMax <- function(kMax, kMaxLowerBound = 1,
        kMaxUpperBound = C_KMAX_UPPER_BOUND, ..., showWarnings = FALSE) {
    .assertIsSingleInteger(kMax, "kMax", validateType = FALSE)
    .assertIsInClosedInterval(kMax, "kMax", lower = kMaxLowerBound, upper = kMaxUpperBound)
    if (showWarnings && kMax > 10) {
        warning("The usage of 'kMax' (", kMax, ") > 10 is not validated", call. = FALSE)
    }
}

.assertAreValidInformationRates <- function(informationRates, kMax = length(informationRates),
        kMaxLowerBound = 1L, kMaxUpperBound = C_KMAX_UPPER_BOUND) {
    if (length(informationRates) < kMaxLowerBound) {
        stop(sprintf(
            paste0(
                C_EXCEPTION_TYPE_ARGUMENT_LENGTH_OUT_OF_BOUNDS,
                "length of 'informationRates' (%s) is out of bounds [%s; %s]"
            ),
            length(informationRates), kMaxLowerBound,
            ifelse(kMax >= kMaxLowerBound && kMax < C_KMAX_UPPER_BOUND, kMax, C_KMAX_UPPER_BOUND)
        ))
    }

    .assertIsValidKMax(kMax, kMaxLowerBound = kMaxLowerBound, kMaxUpperBound = kMaxUpperBound)

    if (length(informationRates) != kMax) {
        stop(sprintf(
            paste0(
                C_EXCEPTION_TYPE_CONFLICTING_ARGUMENTS,
                "length of 'informationRates' (%s) must be equal to 'kMax' (%s)"
            ),
            length(informationRates), kMax
        ))
    }

    if (length(informationRates) > kMaxUpperBound) {
        stop(sprintf(
            paste0(
                C_EXCEPTION_TYPE_ARGUMENT_LENGTH_OUT_OF_BOUNDS,
                "length of 'informationRates' (%s) is out of bounds [%s; %s]"
            ),
            length(informationRates), kMaxLowerBound, kMax
        ))
    }

    if (kMax == 1) {
        return(invisible())
    }

    .assertValuesAreInsideBounds("informationRates", informationRates,
        0, 1,
        lowerBoundInclusive = FALSE
    )

    if (min(informationRates) <= 0 || max(informationRates) > 1 ||
            any(informationRates[2:kMax] <= informationRates[1:(kMax - 1)])) {
        stop(sprintf(
            paste0(
                C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "'informationRates' (%s) ",
                "must be strictly increasing: 0 < x_1 < .. < x_%s <= 1"
            ),
            .arrayToString(informationRates, vectorLookAndFeelEnabled = FALSE), kMax
        ))
    }
}

.assertValuesAreInsideBounds <- function(parameterName, values, lowerBound, upperBound, ...,
        lowerBoundInclusive = TRUE, upperBoundInclusive = TRUE) {
    lower <- min(values)
    upper <- max(values)
    lowerInvalid <- ifelse(lowerBoundInclusive, lower < lowerBound, lower <= lowerBound)
    upperInvalid <- ifelse(upperBoundInclusive, upper > upperBound, upper >= upperBound)
    if (!is.na(lowerInvalid)) {
        if (lowerInvalid || upperInvalid) {
            stop(sprintf(
                paste0(
                    C_EXCEPTION_TYPE_ARGUMENT_OUT_OF_BOUNDS,
                    "'%s' (%s) is out of bounds %s%s; %s%s"
                ),
                parameterName, .arrayToString(values, vectorLookAndFeelEnabled = FALSE),
                ifelse(lowerBoundInclusive, "[", "("), lowerBound,
                upperBound, ifelse(upperBoundInclusive, "]", ")")
            ))
        }
    }
}

.assertContainsNoNas <- function(values, parameterName) {
    if (any(is.na(values))) {
        stop(sprintf(
            paste0(
                C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "'%s' (%s) ",
                "must contain valid numeric values (NA is not allowed)"
            ),
            parameterName, .arrayToString(values, vectorLookAndFeelEnabled = FALSE)
        ))
    }
}

.assertContainsOnlyNasAtTheEnd <- function(values, parameterName) {
    if (length(values) <= 1) {
        return(invisible())
    }

    for (i in length(values):2) {
        if (!is.na(values[i]) && is.na(values[i - 1])) {
            stop(sprintf(
                paste0(
                    C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "'%s' (%s) ",
                    "must contain valid numeric values (NAs are only allowed at the end of the vector)"
                ),
                parameterName, .arrayToString(values, vectorLookAndFeelEnabled = FALSE)
            ))
        }
    }
}

.assertValuesAreStrictlyIncreasing <- function(values, parameterName, endingNasAllowed = FALSE) {
    len <- length(values)
    if (len <= 1) {
        return(invisible())
    }

    if (!endingNasAllowed) {
        .assertContainsNoNas(values, parameterName)
    }

    .assertContainsOnlyNasAtTheEnd(values, parameterName)

    valuesTemp <- values
    values <- na.omit(values)
    len <- length(values)
    if (len <= 1) {
        return(invisible())
    }

    if (any(values[2:len] <= values[1:(len - 1)])) {
        stop(sprintf(
            paste0(
                C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "'%s' (%s) ",
                "must be strictly increasing: x_1 < .. < x_%s"
            ),
            parameterName, .arrayToString(valuesTemp, vectorLookAndFeelEnabled = FALSE), len
        ))
    }
}

.assertValuesAreMonotoneIncreasing <- function(values, parameterName, endingNasAllowed = FALSE) {
    len <- length(values)
    if (len <= 1) {
        return(invisible())
    }

    if (!endingNasAllowed) {
        .assertContainsNoNas(values, parameterName)
    }

    .assertContainsOnlyNasAtTheEnd(values, parameterName)

    valuesTemp <- values
    values <- na.omit(values)
    len <- length(values)
    if (len <= 1) {
        return(invisible())
    }

    if (any(values[2:len] < values[1:(len - 1)])) {
        stop(sprintf(
            paste0(
                C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "'%s' (%s) ",
                "must be increasing: x_1 <= .. <= x_%s"
            ),
            parameterName, .arrayToString(valuesTemp, vectorLookAndFeelEnabled = FALSE), len
        ))
    }
}

.assertAreValidFutilityBounds <- function(futilityBounds, kMax = length(futilityBounds) + 1,
        kMaxLowerBound = 1, kMaxUpperBound = C_KMAX_UPPER_BOUND) {
    if (length(futilityBounds) < kMaxLowerBound - 1) {
        stop(sprintf(
            paste0(
                C_EXCEPTION_TYPE_ARGUMENT_LENGTH_OUT_OF_BOUNDS,
                "length of 'futilityBounds' (%s) is out of bounds [%s; %s]"
            ),
            length(futilityBounds), kMaxLowerBound - 1,
            ifelse(kMax >= kMaxLowerBound && kMax < C_KMAX_UPPER_BOUND, kMax - 1, C_KMAX_UPPER_BOUND - 1)
        ))
    }

    .assertIsValidKMax(kMax, kMaxLowerBound = kMaxLowerBound, kMaxUpperBound = kMaxUpperBound)

    if (length(futilityBounds) != kMax - 1) {
        stop(
            C_EXCEPTION_TYPE_CONFLICTING_ARGUMENTS,
            "length of 'futilityBounds' (", length(futilityBounds),
            ") must be equal to 'kMax' (", kMax, ") - 1"
        )
    }

    .assertValuesAreInsideBounds("futilityBounds", futilityBounds, -Inf, 6)
}

.assertIsValidCipher <- function(key, value) {
    if (getCipheredValue(value) != C_CIPHERS[[key]]) {
        stop(C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "'token' and/or 'secret' unkown")
    }
}

.assertIsValidAlpha0Vec <- function(alpha0Vec, kMax = length(alpha0Vec) - 1,
        kMaxLowerBound = 1, kMaxUpperBound = C_KMAX_UPPER_BOUND) {
    if (length(alpha0Vec) < kMaxLowerBound - 1) {
        stop(sprintf(
            paste0(
                C_EXCEPTION_TYPE_ARGUMENT_LENGTH_OUT_OF_BOUNDS,
                "length of 'alpha0Vec' (%s) is out of bounds [%s; %s]"
            ),
            length(alpha0Vec), kMaxLowerBound - 1, kMax - 1
        ))
    }

    .assertIsValidKMax(kMax, kMaxLowerBound = kMaxLowerBound, kMaxUpperBound = kMaxUpperBound)

    if (length(alpha0Vec) != kMax - 1) {
        stop(
            C_EXCEPTION_TYPE_CONFLICTING_ARGUMENTS,
            "length of 'alpha0Vec' (", length(alpha0Vec),
            ") must be equal to 'kMax' (", kMax, ") - 1"
        )
    }

    .assertValuesAreInsideBounds("alpha0Vec", alpha0Vec, 0, 1, lowerBoundInclusive = FALSE)
}

.assertIsValidSidedParameter <- function(sided) {
    if (is.null(match.call(expand.dots = FALSE)[["sided"]])) {
        stop(C_EXCEPTION_TYPE_MISSING_ARGUMENT, "'sided' must be defined")
    }
    if (sided != 1 && sided != 2) {
        stop(C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "'sided' (", sided, ") must be 1 or 2")
    }
}

.assertIsValidGroupsParameter <- function(groups) {
    if (is.null(match.call(expand.dots = FALSE)[["groups"]])) {
        stop(C_EXCEPTION_TYPE_MISSING_ARGUMENT, "'groups' must be defined")
    }
    if (groups != 1 && groups != 2) {
        stop(C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "'groups' (", groups, ") must be 1 or 2")
    }
}

.allArgumentsAreNotNull <- function(...) {
    args <- list(...)
    naCounter <- 0
    for (arg in args) {
        if (!is.null(arg)) {
            naCounter <- naCounter + sum(is.na(arg))
        }
    }
    return(naCounter == 0)
}

.assertAssociatedArgumentsAreDefined <- function(...) {
    .associatedArgumentsAreDefined(..., warningOnlyEnabled = FALSE)
}

.associatedArgumentsAreDefined <- function(..., warningOnlyEnabled = TRUE) {
    args <- NULL
    tryCatch(expr = {
        args <- list(...)
    }, error = function(e) {
        stop(simpleError(paste0(C_EXCEPTION_TYPE_MISSING_ARGUMENT, e$message), call = e$call))
    })

    if (.allArgumentsAreNotNull(...)) {
        return(invisible(TRUE))
    }

    args <- args[args != "warningOnlyEnabled" & !is.null(args)]
    argNames <- names(args)
    if (sum(argNames == "") > 0) {
        stop(C_EXCEPTION_TYPE_RUNTIME_ISSUE, "each argument must have a name defined, e.g. a = a")
    }

    definedArguments <- c()
    undefinedArguments <- c()
    for (i in 1:length(args)) {
        arg <- args[i]
        argName <- argNames[i]
        if (missing(arg) || (!is.null(arg) && sum(is.na(arg)) > 0)) {
            undefinedArguments <- c(undefinedArguments, argName)
        } else {
            definedArguments <- c(definedArguments, argName)
        }
    }
    if (length(undefinedArguments) > 0 && length(definedArguments) > 0) {
        message <- paste0(
            .arrayToString(undefinedArguments, encapsulate = TRUE),
            " ", ifelse(warningOnlyEnabled, "should", "must"),
            " be defined because ", .arrayToString(definedArguments, encapsulate = TRUE),
            ifelse(length(definedArguments) > 1, " are", " is"), " defined"
        )
        if (warningOnlyEnabled) {
            warning(C_EXCEPTION_TYPE_INCOMPLETE_ARGUMENTS, message, call. = FALSE)
            return(FALSE)
        } else {
            stop(C_EXCEPTION_TYPE_MISSING_ARGUMENT, message)
        }
    }

    return(invisible(length(definedArguments) == length(args)))
}

.assertIsValidNPlanned <- function(nPlanned, kMax, stage, ..., required = TRUE) {
    if (is.null(nPlanned) || (length(nPlanned) > 0 && all(is.na(nPlanned)))) {
        if (!required) {
            return(invisible())
        }
        stop(C_EXCEPTION_TYPE_MISSING_ARGUMENT, "'nPlanned' must be specified")
    }

    if (length(nPlanned) != kMax - stage) {
        stop(
            C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT,
            sprintf(
                paste0(
                    "'nPlanned' (%s) is invalid: ",
                    "length must be equal to %s (kMax - stage = %s - %s)"
                ),
                .arrayToString(nPlanned), kMax - stage, kMax, stage
            )
        )
    }

    if (sum(is.na(nPlanned)) > 0 || sum(nPlanned <= 0) > 0) {
        stop(
            C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT,
            sprintf(
                paste0(
                    "'nPlanned' (%s) is invalid: ",
                    "all values must be > 0"
                ),
                .arrayToString(nPlanned)
            )
        )
    }
}

.isValidNPlanned <- function(nPlanned, kMax, stage) {
    if (missing(nPlanned)) {
        warning("'nPlanned' is missing", call. = FALSE)
        return(FALSE)
    }
    if (!any(is.na(nPlanned))) {
        if ((length(nPlanned) != kMax - stage)) {
            warning(sprintf(
                paste0(
                    "'nPlanned' (%s) will be ignored: ",
                    "length must be equal to %s (kMax - stage = %s - %s)"
                ),
                .arrayToString(nPlanned), kMax - stage, kMax, stage
            ), call. = FALSE)
            return(FALSE)
        }

        if (sum(is.na(nPlanned)) > 0 || sum(nPlanned <= 0) > 0) {
            warning(sprintf(
                paste0(
                    "'nPlanned' (%s) will be ignored: ",
                    "all values must be > 0"
                ),
                .arrayToString(nPlanned)
            ), call. = FALSE)
            return(FALSE)
        }
    }
    return(TRUE)
}

.warnInCaseOfUnknownArguments <- function(..., functionName, ignore = character(0),
        numberOfAllowedUnnamedParameters = 0, exceptionEnabled = FALSE) {
    args <- list(...)
    if (length(args) == 0) {
        return(invisible())
    }

    if (numberOfAllowedUnnamedParameters > 0) {
        ignore <- c(ignore, paste0("%param", 1:numberOfAllowedUnnamedParameters, "%"))
    }
    ignore <- c(ignore, "showWarnings")
    argNames <- names(args)
    for (i in 1:length(args)) {
        arg <- args[[i]]
        argName <- ifelse(is.null(argNames[i]) || argNames[i] == "",
            ifelse(inherits(arg, "StageResults"), "stageResultsName", paste0("%param", i, "%")),
            argNames[i]
        )
        if (!(argName %in% ignore) && !grepl("^\\.", argName)) {
            if (isS4(arg) || is.environment(arg)) {
                arg <- .getClassName(arg)
            }
            if (is.function(arg)) {
                arg <- "function(...)"
            }
            argValue <- paste0(" (", .getClassName(arg), ")")
            tryCatch(expr = {
                argValue <- .arrayToString(arg, vectorLookAndFeelEnabled = length(arg) > 1, encapsulate = is.character(arg))
                argValue <- paste0(" = ", argValue)
            }, error = function(e) {})
            if (exceptionEnabled) {
                stop(C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT,
                    "argument unknown in ", functionName, "(...): '", argName, "'",
                    argValue, " is not allowed",
                    call. = FALSE
                )
            } else {
                warning("Argument unknown in ", functionName, "(...): '", argName, "'",
                    argValue, " will be ignored",
                    call. = FALSE
                )
            }
        }
    }
}

.warnInCaseOfUnusedArgument <- function(arg, argName, defaultValue, functionName) {
    if (!identical(arg, defaultValue)) {
        warning("Unused argument in ", functionName, "(...): '",
            argName, "' = ", .arrayToString(arg, vectorLookAndFeelEnabled = (length(arg) > 1), maxLength = 10),
            " will be ignored",
            call. = FALSE
        )
    }
}

.isTrialDesignWithValidFutilityBounds <- function(design) {
    if (is.null(design) || !.isTrialDesignInverseNormalOrGroupSequential(design)) {
        return(FALSE)
    }

    futilityBounds <- design[["futilityBounds"]]
    if (is.null(futilityBounds)) {
        return(FALSE)
    }

    if (length(futilityBounds) == 0 || sum(is.na(futilityBounds)) == design$kMax) {
        return(FALSE)
    }

    return(any(na.omit(futilityBounds) > C_FUTILITY_BOUNDS_DEFAULT))
}

.isTrialDesignWithValidAlpha0Vec <- function(design) {
    if (is.null(design) || !.isTrialDesignFisher(design)) {
        return(FALSE)
    }

    alpha0Vec <- design[["alpha0Vec"]]
    if (is.null(alpha0Vec)) {
        return(FALSE)
    }

    alpha0Vec <- na.omit(alpha0Vec)
    if (length(alpha0Vec) == 0 || all(is.na(alpha0Vec))) {
        return(FALSE)
    }

    return(any(alpha0Vec != C_ALPHA_0_VEC_DEFAULT))
}

.assertPackageIsInstalled <- function(packageName) {
    if (!requireNamespace(packageName, quietly = TRUE)) {
        stop("Package \"", packageName, "\" is needed for this function to work. ",
            "Please install using, e.g., install.packages(\"", packageName, "\")",
            call. = FALSE
        )
    }
}

.assertGgplotIsInstalled <- function() {
    .assertPackageIsInstalled("ggplot2")
}

.assertRcppIsInstalled <- function() {
    .assertPackageIsInstalled("Rcpp")
}

.assertTestthatIsInstalled <- function() {
    .assertPackageIsInstalled("testthat")
}

.assertMnormtIsInstalled <- function() {
    .assertPackageIsInstalled("mnormt")
}

.assertIsValidThetaH0 <- function(thetaH0, ..., endpoint = c("means", "rates", "survival"),
        groups, ratioEnabled = FALSE) {
    .warnInCaseOfUnknownArguments(functionName = ".assertIsValidThetaH0", ...)

    if (is.na(thetaH0)) {
        return(invisible())
    }

    if (!is.numeric(thetaH0)) {
        stop(C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "'thetaH0' must be a valid numeric value")
    }

    endpoint <- match.arg(endpoint)
    if (endpoint == "means" || endpoint == "rates") {
        if (groups == 2 && ratioEnabled) {
            if (thetaH0 <= 0) {
                stop(C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "'thetaH0' (", thetaH0, ") must be > 0")
            }
            return(invisible())
        }
    }

    if (endpoint == "rates") {
        if (groups == 1) {
            if (thetaH0 <= 0 || thetaH0 >= 1) {
                stop(
                    C_EXCEPTION_TYPE_ARGUMENT_OUT_OF_BOUNDS,
                    "'thetaH0' (", thetaH0, ") is out of bounds (0; 1) or not specified"
                )
            }
        } else {
            if (thetaH0 <= -1 || thetaH0 >= 1) {
                stop(
                    C_EXCEPTION_TYPE_ARGUMENT_OUT_OF_BOUNDS,
                    "'thetaH0' (", thetaH0, ") is out of bounds (-1; 1)"
                )
            }
        }
    } else if (endpoint == "survival") {
        if (thetaH0 <= 0) {
            stop(C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "'thetaH0' (", thetaH0, ") must be > 0")
        }
    }
}

.assertIsValidThetaH0DataInput <- function(thetaH0, dataInput) {
    if (.isDatasetRates(dataInput)) {
        endpoint <- "rates"
    } else if (.isDatasetSurvival(dataInput)) {
        endpoint <- "survival"
    } else {
        endpoint <- "means"
    }
    .assertIsValidThetaH0(thetaH0, endpoint = endpoint, groups = dataInput$getNumberOfGroups())
}

.assertIsValidThetaRange <- function(..., thetaRange, thetaAutoSeqEnabled = TRUE, survivalDataEnabled = FALSE) {
    if (is.null(thetaRange) || (thetaAutoSeqEnabled && length(thetaRange) <= 1) ||
            any(is.na(thetaRange))) {
        stop(
            C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT,
            "'thetaRange' (", .arrayToString(thetaRange), ") must be a vector ",
            "with two entries defining minimum and maximum ",
            "or a sequence of numeric values with length > 2"
        )
    } else if (length(thetaRange) == 2 && thetaAutoSeqEnabled) {
        minValue <- thetaRange[1]
        maxValue <- thetaRange[2]
        if (survivalDataEnabled) {
            .assertIsValidHazardRatio(minValue, "thetaRange[1]")
            .assertIsValidHazardRatio(maxValue, "thetaRange[2]")
        }
        if (minValue >= maxValue) {
            stop(
                C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT,
                "'thetaRange' with length 2 must contain minimum < maximum (",
                minValue, " >= ", maxValue, ")"
            )
        }
        by <- (maxValue - minValue) / C_THETA_RANGE_SEQUENCE_LENGTH_DEFAULT
        thetaRange <- seq(minValue, maxValue, by)
    }

    invisible(thetaRange)
}

.assertIsValidPiTreatmentRange <- function(..., piTreatmentRange, piAutoSeqEnabled = TRUE) {
    if (is.null(piTreatmentRange) || (piAutoSeqEnabled && length(piTreatmentRange) <= 1) ||
            any(is.na(piTreatmentRange))) {
        stop(
            C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT,
            "'piTreatmentRange' (", .arrayToString(piTreatmentRange), ") must be a vector ",
            "with two entries defining minimum and maximum ",
            "or a sequence of numeric values with length > 2"
        )
    } else if (length(piTreatmentRange) == 2) {
        if (piAutoSeqEnabled) {
            minValue <- piTreatmentRange[1]
            maxValue <- piTreatmentRange[2]
            if (minValue == 0) {
                minValue <- 0.00000001
            }
            if (maxValue == 1) {
                maxValue <- 0.99999999
            }
            .assertIsValidPi(minValue, "piTreatmentRange[1]")
            .assertIsValidPi(maxValue, "piTreatmentRange[2]")
            if (minValue >= maxValue) {
                stop(
                    C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT,
                    "'piTreatmentRange' with length 2 must contain minimum < maximum (",
                    minValue, " >= ", maxValue, ")"
                )
            }
            by <- (maxValue - minValue) / C_THETA_RANGE_SEQUENCE_LENGTH_DEFAULT
            piTreatmentRange <- seq(minValue, maxValue, by)
        }
    }

    invisible(piTreatmentRange)
}

.assertIsValidPi <- function(piValue, piName) {
    if (is.null(piValue) || length(piValue) == 0) {
        stop(
            C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT,
            "'", piName, "' must be a valid numeric value"
        )
    }

    if (all(is.na(piValue))) {
        return(invisible())
    }

    if (!is.numeric(piValue) || any(is.na(piValue))) {
        stop(
            C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT,
            "'", piName, "' (", .arrayToString(piValue), ") must be a valid numeric value"
        )
    }

    if (any(piValue <= -1e-16) || any(piValue >= 1 + 1e-16)) {
        stop(
            C_EXCEPTION_TYPE_ARGUMENT_OUT_OF_BOUNDS,
            "'", piName, "' (", .arrayToString(piValue), ") is out of bounds (0; 1) or event time too long"
        )
    }
}

.assertIsValidPi1 <- function(pi1, stageResults = NULL, stage = NULL) {
    if (is.na(pi1) && !is.null(stageResults) && !is.null(stage)) {
        if (stageResults$isOneSampleDataset()) {
            pi1 <- stageResults$overallEvents[stage] / stageResults$overallSampleSizes[stage]
        } else {
            pi1 <- stageResults$overallEvents1[stage] / stageResults$overallSampleSizes1[stage]
        }
    }
    .assertIsInClosedInterval(pi1, "pi1", lower = 0, upper = 1)
    invisible(pi1)
}

.assertIsValidPi2 <- function(pi2, stageResults = NULL, stage = NULL) {
    if (is.na(pi2) && !is.null(stageResults) && !is.null(stage)) {
        pi2 <- stageResults$overallEvents2[stage] / stageResults$overallSampleSizes2[stage]
    }
    .assertIsInClosedInterval(pi2, "pi2", lower = 0, upper = 1)
    invisible(pi2)
}

.assertIsValidAllocationRatioPlanned <- function(allocationRatioPlanned, numberOfGroups) {
    if (numberOfGroups == 1) {
        return(invisible())
    }

    .assertIsSingleNumber(allocationRatioPlanned, "allocationRatioPlanned")
    .assertIsInOpenInterval(
        allocationRatioPlanned,
        "allocationRatioPlanned", 0, C_ALLOCATION_RATIO_MAXIMUM
    )
    if (allocationRatioPlanned != C_ALLOCATION_RATIO_DEFAULT && numberOfGroups == 1) {
        warning("Planned allocation ratio ", allocationRatioPlanned, " will be ignored ",
            "because the specified data has only one group",
            call. = FALSE
        )
    }
}

.assertIsValidAllocationRatioPlannedSampleSize <- function(allocationRatioPlanned, maxNumberOfSubjects = NA_real_) {
    .assertIsSingleNumber(allocationRatioPlanned, "allocationRatioPlanned")

    if (allocationRatioPlanned < 0) {
        stop(
            C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT,
            "'allocationRatioPlanned' (", allocationRatioPlanned, ") must be >= 0"
        )
    }

    if (length(maxNumberOfSubjects) > 0 && !is.na(maxNumberOfSubjects) &&
            maxNumberOfSubjects > 0 && allocationRatioPlanned == 0) {
        stop(
            C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT,
            "determination of optimal allocation ratio not possible ",
            "if explicit or implicit 'maxNumberOfSubjects' (", maxNumberOfSubjects,
            ") > 0, i.e., follow-up time should be calculated ",
            "(please specify an 'allocationRatioPlanned' > 0)"
        )
    }
}

.assertIsValidThetaH1 <- function(thetaH1, stageResults = NULL,
        stage = NULL, ..., results = NULL) {
    if (is.na(thetaH1) && !is.null(stageResults) && !is.null(stage)) {
        thetaH1 <- stageResults$effectSizes[stage]
        if (!is.null(results)) {
            results$.setParameterType("thetaH1", C_PARAM_GENERATED)
        }
    }
    .assertIsSingleNumber(thetaH1, "thetaH1")
    invisible(thetaH1)
}

.assertIsValidAssumedStDev <- function(assumedStDev,
        stageResults = NULL, stage = NULL, ..., results = NULL) {
    if (is.na(assumedStDev) && !is.null(stageResults) && !is.null(stage)) {
        assumedStDev <- stageResults$overallStDevs[stage]
        if (!is.null(results)) {
            results$.setParameterType("assumedStDev", C_PARAM_GENERATED)
        }
    }
    .assertIsSingleNumber(assumedStDev, "assumedStDev")
    if (assumedStDev <= 0) {
        stop(
            C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT,
            "'assumedStDev' (", assumedStDev, ") must be > 0"
        )
    }
    invisible(assumedStDev)
}

.assertIsValidThetaH1ForMultiArm <- function(thetaH1,
        stageResults = NULL, stage = NULL, ..., results = NULL) {
    if (!is.null(stageResults) && all(is.na(thetaH1)) && !is.null(stage)) {
        thetaH1 <- stageResults$effectSizes[, stage]
        if (!is.null(results)) {
            results$.setParameterType("thetaH1", C_PARAM_GENERATED)
        }
    }

    .assertIsNumericVector(thetaH1, "thetaH1", naAllowed = TRUE)
    invisible(thetaH1)
}

.assertIsValidThetaH1ForEnrichment <- function(thetaH1,
        stageResults = NULL, stage = NULL, ..., results = NULL) {
    invisible(.assertIsValidThetaH1ForMultiArm(
        thetaH1 = thetaH1,
        stageResults = stageResults, stage = stage, results = results
    ))
}

.assertIsValidAssumedStDevForMultiHypotheses <- function(assumedStDev,
        stageResults = NULL, stage = NULL, ..., results = NULL) {
    if (!is.null(stageResults) && all(is.na(assumedStDev)) && !is.null(stage)) {
        if (is.matrix(stageResults$overallStDevs)) { # inherits(stageResults, "StageResultsMultiArmMeans")
            assumedStDev <- stageResults$overallStDevs[, stage]
        } else {
            assumedStDev <- stageResults$overallStDevs[stage]
        }

        if (!is.null(results)) {
            results$.setParameterType("assumedStDevs", C_PARAM_GENERATED)
        }
    }
    .assertIsNumericVector(assumedStDev, "assumedStDev", naAllowed = TRUE)
    if (any(assumedStDev <= 0, na.rm = TRUE)) {
        stop(
            C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT,
            "'assumedStDev' (", .arrayToString(assumedStDev), ") must be > 0"
        )
    }

    invisible(assumedStDev)
}

.assertIsValidAssumedStDevs <- function(assumedStDevs, gMax) {
    if (length(assumedStDevs) != 1 && length(assumedStDevs) != gMax) {
        stop(
            C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT,
            sprintf(paste0(
                "length of 'assumedStDevs' (%s) ",
                "must be equal to 'gMax' (%s) or 1"
            ), .arrayToString(assumedStDevs), gMax)
        )
    }
}

.assertIsValidPiTreatmentsForMultiArm <- function(piTreatments,
        stageResults = NULL, stage = NULL, ..., results = NULL) {
    if (!is.null(stageResults) && all(is.na(piTreatments)) && !is.null(stage)) {
        piTreatments <- stageResults$overallPiTreatments[, stage]
        if (!is.null(results)) {
            results$.setParameterType("piTreatments", C_PARAM_GENERATED)
        }
    }
    .assertIsNumericVector(piTreatments, "piTreatments", naAllowed = TRUE)
    .assertIsInClosedInterval(piTreatments, "piTreatments", lower = 0, upper = 1, naAllowed = TRUE)
    invisible(piTreatments)
}

.assertIsValidPiControlForMultiArm <- function(piControl,
        stageResults = NULL, stage = NULL, ..., results = NULL) {
    if (!is.null(stageResults) && is.na(piControl) && !is.null(stage)) {
        piControl <- stageResults$overallPiControl[, stage]
        if (!is.null(results)) {
            results$.setParameterType("piControl", C_PARAM_GENERATED)
        }
    }
    .assertIsNumericVector(piControl, "piControl", naAllowed = TRUE)
    .assertIsInClosedInterval(piControl, "piControl", lower = 0, upper = 1)
    invisible(piControl)
}

.assertIsValidPiTreatmentsForEnrichment <- function(piTreatments,
        stageResults = NULL, stage = NULL, ..., results = NULL) {
    if (!is.null(stageResults) && all(is.na(piTreatments)) && !is.null(stage)) {
        piTreatments <- stageResults$overallPisTreatment[, stage]
        if (!is.null(results)) {
            results$.setParameterType("piTreatments", C_PARAM_GENERATED)
        }
    }
    .assertIsNumericVector(piTreatments, "piTreatments", naAllowed = TRUE)
    .assertIsInClosedInterval(piTreatments, "piTreatments", lower = 0, upper = 1, naAllowed = TRUE)
    invisible(piTreatments)
}

.assertIsValidPiControlForEnrichment <- function(piControls,
        stageResults = NULL, stage = NULL, ..., results = NULL) {
    if (!is.null(stageResults) && all(is.na(piControls)) && !is.null(stage)) {
        piControls <- stageResults$overallPisControl[, stage]
        if (!is.null(results)) {
            results$.setParameterType("piControls", C_PARAM_GENERATED)
        }
    }
    .assertIsNumericVector(piControls, "piControls", naAllowed = TRUE)
    .assertIsInClosedInterval(piControls, "piControls", lower = 0, upper = 1, naAllowed = TRUE)
    invisible(piControls)
}

.assertIsValidHazardRatio <- function(hazardRatio, thetaH0) {
    .assertIsNumericVector(hazardRatio, "hazardRatio")
    if (any(hazardRatio == thetaH0)) {
        stop(
            C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT,
            "alternative not correctly specified: ",
            "each hazard ratio (",
            .arrayToString(hazardRatio[1:min(length(hazardRatio), 10)]),
            ") must be unequal to 'thetaH0' (", thetaH0, ")"
        )
    }
}

.assertIsValidHazardRatioVector <- function(hazardRatio) {
    .assertIsNumericVector(hazardRatio, "hazardRatio")
    if (any(hazardRatio <= 0)) {
        if (length(hazardRatio) == 1) {
            stop(C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "'hazardRatio' (", hazardRatio, ") must be > 0")
        } else {
            stop(
                C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "each 'hazardRatio' (",
                .arrayToString(hazardRatio[1:min(length(hazardRatio), 10)]),
                ") must be > 0"
            )
        }
    }
}

.assertIsValidDirectionUpper <- function(directionUpper, sided,
        objectType = c("sampleSize", "power"), userFunctionCallEnabled = FALSE) {
    objectType <- match.arg(objectType)

    .assertIsSingleLogical(directionUpper, "directionUpper", naAllowed = TRUE)

    if (objectType == "power") {
        if (sided == 1 && is.na(directionUpper)) {
            directionUpper <- TRUE
        }
        if (userFunctionCallEnabled && sided == 2 && !is.na(directionUpper)) {
            warning("'directionUpper' will be ignored because it ",
                "is not applicable for 'sided' = 2",
                call. = FALSE
            )
        }
    } else if (is.na(directionUpper)) {
        directionUpper <- TRUE
    }

    return(directionUpper)
}

.assertIsFunction <- function(fun) {
    if (is.null(fun)) {
        stop(C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "'fun' must be a valid function")
    }
    if (!is.function(fun)) {
        stop(C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "'fun' must be a function (is ", .getClassName(fun), ")")
    }
}

.assertIsValidFunction <- function(fun, ...,
        funArgName = "fun",
        expectedArguments = NULL,
        expectedFunction = NULL,
        identical = FALSE,
        validateThreeDots = TRUE,
        showUnusedArgumentsMessage = FALSE,
        namedArgumentsExpected = FALSE) {
    fCall <- match.call(expand.dots = FALSE)

    if (is.null(expectedArguments) && is.null(expectedFunction)) {
        stop(
            C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT,
            "'expectedArguments' or 'expectedFunction' must be not NULL"
        )
    }

    if (!is.function(fun)) {
        stop(
            C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT,
            "'", funArgName, "' must be a function"
        )
    }

    functionName <- as.character(fCall$fun)
    if (is.null(functionName) || functionName == funArgName) {
        functionName <- "function"
    }

    argNames <- methods::formalArgs(fun)
    if (!is.null(expectedArguments)) {
        argNamesExpected <- expectedArguments
    } else if (!is.null(expectedFunction)) {
        if (!is.function(expectedFunction)) {
            stop(
                C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT,
                "'expectedFunction' must be a function"
            )
        }
        argNamesExpected <- methods::formalArgs(expectedFunction)
    }

    if (validateThreeDots) {
        if (!("..." %in% argNames)) {
            stop(
                C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT,
                "'", funArgName, "' must contain the three-dots argument '...', e.g., ",
                funArgName, " = ", functionName, "(", .arrayToString(argNames), ", ...)"
            )
        }
    }
    argNames <- argNames[argNames != "..."]
    argNamesExpected <- argNamesExpected[argNamesExpected != "..."]

    if (length(argNamesExpected) < ifelse(namedArgumentsExpected, 1, 2) &&
            length(argNames) == length(argNamesExpected)) {
        return(invisible())
    }

    for (argName in argNames) {
        if (argName != "..." && !(argName %in% argNamesExpected)) {
            msg <- paste0(
                C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT,
                "the argument '", argName, "' in '", funArgName,
                "' (", functionName, ") is not allowed."
            )
            if (length(argNamesExpected) == 1) {
                stop(msg, " Expected: '", argNamesExpected, "'")
            }
            stop(
                msg, "\n\n", "Use one or more of the following arguments:\n ",
                .arrayToString(argNamesExpected, encapsulate = TRUE)
            )
        }
    }

    if (identical) {
        for (argNameExpected in argNamesExpected) {
            if (argNameExpected != "..." && !(argNameExpected %in% argNames)) {
                stop(
                    C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT,
                    "'", funArgName, "' (", functionName, ") must contain ",
                    "an argument with name '", argNameExpected, "'"
                )
            }
        }
        return(invisible())
    }

    counter <- 0
    unusedArgs <- c()
    for (argNameExpected in argNamesExpected) {
        if (argNameExpected %in% argNames) {
            counter <- counter + 1
        } else {
            unusedArgs <- c(unusedArgs, argNameExpected)
        }
    }

    if (counter == 0) {
        stop(
            C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT,
            "'", funArgName, "' (", functionName, ") must contain at ",
            "least one of the following arguments: ",
            .arrayToString(argNamesExpected)
        )
    }

    if (showUnusedArgumentsMessage && length(unusedArgs) > 0) {
        message("Note that the following arguments can optionally be used in '",
            funArgName, "' (", functionName, "): \n",
            .arrayToString(unusedArgs),
            call. = FALSE
        )
    }
}

.assertIsValidThreshold <- function(threshold, activeArms) {
    .assertIsNumericVector(threshold, "threshold", naAllowed = TRUE)
    if ((length(threshold) != 1) && (length(threshold) != activeArms)) {
        stop(
            C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "'threshold' (", .arrayToString(threshold),
            ") must be a single value or a vector of length ", activeArms
        )
    }
}

.assertIsValidPlannedSubjectsOrEvents <- function(design,
        plannedValues,
        parameterName = c("plannedSubjects", "plannedEvents")) {
    parameterName <- match.arg(parameterName)
    .assertIsIntegerVector(plannedValues, parameterName, validateType = FALSE)
    if (length(plannedValues) != design$kMax) {
        stop(
            C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT,
            "'", parameterName, "' (", .arrayToString(plannedValues), ") must have length ", design$kMax
        )
    }
    .assertIsInClosedInterval(plannedValues, parameterName, lower = 1, upper = NULL)
    .assertValuesAreStrictlyIncreasing(plannedValues, parameterName)
}

.assertIsValidNumberOfSubjectsPerStage <- function(parameterValues, parameterName, plannedSubjects,
        conditionalPower, calcSubjectsFunction, kMax,
        endpoint = c("means", "rates", "survival"), calcSubjectsFunctionEnabled = TRUE) {
    endpoint <- match.arg(endpoint)

    if (kMax == 1) {
        .ignoreParameterIfNotUsed(
            "conditionalPower",
            conditionalPower, kMax > 1, "design is fixed ('kMax' = 1)"
        )
        return(invisible(NA_real_))
    }

    .assertIsNumericVector(parameterValues, parameterName, naAllowed = TRUE)

    calcSubjectsFunctionName <- ifelse(endpoint == "survival", "calcEventsFunction", "calcSubjectsFunction")

    if (is.na(conditionalPower) && is.null(calcSubjectsFunction)) {
        if (length(parameterValues) != 1 || !is.na(parameterValues)) {
            if (calcSubjectsFunctionEnabled) {
                warning("'", parameterName, "' (", .arrayToString(parameterValues), ") ",
                    "will be ignored because neither 'conditionalPower' nor '",
                    calcSubjectsFunctionName, "' is defined",
                    call. = FALSE
                )
            } else {
                warning("'", parameterName, "' (", .arrayToString(parameterValues), ") ",
                    "will be ignored because 'conditionalPower' is not defined",
                    call. = FALSE
                )
            }
        }
        return(invisible(NA_real_))
    }

    if (!is.na(conditionalPower) && length(parameterValues) == 0 ||
            (length(parameterValues) == 1 && is.na(parameterValues))) {
        if (calcSubjectsFunctionEnabled) {
            stop(
                C_EXCEPTION_TYPE_MISSING_ARGUMENT,
                "'", parameterName, "' must be defined ",
                "because 'conditionalPower' or '", calcSubjectsFunctionName, "' is defined"
            )
        } else {
            stop(
                C_EXCEPTION_TYPE_MISSING_ARGUMENT,
                "'", parameterName, "' must be defined ",
                "because 'conditionalPower' is defined"
            )
        }
    }

    if (length(parameterValues) != kMax) {
        stop(
            C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "'", parameterName, "' (",
            .arrayToString(parameterValues), ") must have length ", kMax
        )
    }

    if (any(is.na(parameterValues[2:length(parameterValues)]))) {
        stop(
            C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "'", parameterName, "' (",
            .arrayToString(parameterValues), ") must contain valid numeric values"
        )
    }

    if (!is.na(parameterValues[1]) && parameterValues[1] != plannedSubjects[1]) {
        warning("First value of '", parameterName, "' (", parameterValues[1], ") will be ignored", call. = FALSE)
    }

    parameterValues[1] <- plannedSubjects[1]

    .assertIsInClosedInterval(parameterValues, parameterName, lower = 1, upper = NULL)

    return(invisible(parameterValues))
}

.assertIsValidMaxNumberOfSubjects <- function(maxNumberOfSubjects, naAllowed = FALSE) {
    .assertIsSingleNumber(maxNumberOfSubjects, "maxNumberOfSubjects", naAllowed = naAllowed)
    .assertIsInClosedInterval(maxNumberOfSubjects, "maxNumberOfSubjects", lower = 1, upper = NULL, naAllowed = naAllowed)
}

.assertAreSuitableInformationRates <- function(design, dataInput, stage) {
    if (!.isTrialDesignGroupSequential(design) || stage == 1) {
        return(invisible())
    }

    param <- NA_character_
    paramValues <- NA_real_
    if (dataInput$isDatasetSurvival()) {
        if (any(abs(design$informationRates[2:stage] - dataInput$getOverallEventsUpTo(stage)[2:stage] /
                dataInput$getOverallEventsUpTo(1) * design$informationRates[1]) >
                C_ACCEPT_DEVIATION_INFORMATIONRATES)) {
            param <- "events"
            paramValues <- dataInput$getOverallEventsUpTo(stage)
        }
    } else {
        if (dataInput$getNumberOfGroups() == 1) {
            if (any(abs(design$informationRates[2:stage] -
                    dataInput$getOverallSampleSizesUpTo(stage)[2:stage] /
                        dataInput$getOverallSampleSizesUpTo(1) * design$informationRates[1]) >
                    C_ACCEPT_DEVIATION_INFORMATIONRATES)) {
                param <- "sample sizes"
                paramValues <- dataInput$getOverallSampleSizesUpTo(stage)
            }
        } else if (dataInput$getNumberOfGroups() == 2) {
            if (any(abs(design$informationRates[2:stage] -
                    dataInput$getOverallSampleSizesUpTo(stage)[2:stage] /
                        dataInput$getOverallSampleSizesUpTo(1) * design$informationRates[1]) >
                    C_ACCEPT_DEVIATION_INFORMATIONRATES) ||
                    any(abs(design$informationRates[2:stage] -
                        dataInput$getOverallSampleSizesUpTo(stage, 2)[2:stage] /
                            dataInput$getOverallSampleSizesUpTo(1, 2) * design$informationRates[1]) >
                        C_ACCEPT_DEVIATION_INFORMATIONRATES)) {
                param <- "sample sizes"
                paramValues <- dataInput$getOverallSampleSizesUpTo(stage) + dataInput$getOverallSampleSizesUpTo(stage, 2)
            }
        }
    }
    if (!is.na(param)) {
        warning("Observed ", param, " (", .arrayToString(paramValues),
            ") not according to specified information rates (",
            .arrayToString(design$informationRates[1:stage]), ") in ",
            "group sequential design. ",
            "Test procedure might not control Type I error rate",
            call. = FALSE
        )
    }
}

.assertIsOneSidedDesign <- function(design,
        designType = c("multi-arm", "enrichment"),
        engineType = c("simulation", "analysis")) {
    if (design$sided == 2) {
        designType <- match.arg(designType)
        engineType <- match.arg(engineType)
        stop(
            C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT,
            designType, " ", engineType, " is only applicable for one-sided testing"
        )
    }
}

.isMultiArmDataset <- function(dataInput) {
    return(inherits(dataInput, "Dataset") && dataInput$getNumberOfGroups() > 2)
}

.isMultiArmStageResults <- function(stageResults) {
    return(inherits(stageResults, "StageResults") && grepl("MultiArm", .getClassName(stageResults)))
}

.isEnrichmentStageResults <- function(stageResults) {
    return(inherits(stageResults, "StageResults") && grepl("Enrichment", .getClassName(stageResults)))
}

.isEnrichmentConditionalPowerResults <- function(conditionalPowerResults) {
    return(inherits(conditionalPowerResults, "ConditionalPowerResults") &&
        grepl("Enrichment", .getClassName(conditionalPowerResults)))
}

.isMultiArmAnalysisResults <- function(analysisResults) {
    return(inherits(analysisResults, "AnalysisResultsMultiArm"))
}

.isMultiHypothesesAnalysisResults <- function(x) {
    return(.isMultiArmAnalysisResults(x) || .isEnrichmentAnalysisResults(x))
}

.isEnrichmentDataset <- function(dataInput) {
    return(inherits(dataInput, "Dataset") && dataInput$.enrichmentEnabled)
}

.isEnrichmentAnalysisResults <- function(analysisResults) {
    return(inherits(analysisResults, "AnalysisResultsEnrichment"))
}

.isMultiArmSimulationResults <- function(simulationResults) {
    return(inherits(simulationResults, "SimulationResults") && grepl("MultiArm", .getClassName(simulationResults)))
}

.isEnrichmentSimulationResults <- function(simulationResults) {
    return(inherits(simulationResults, "SimulationResults") && grepl("Enrichment", .getClassName(simulationResults)))
}

.assertIsStageResultsMultiArm <- function(stageResults) {
    if (!inherits(stageResults, "StageResults")) {
        stop(
            C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT,
            "'stageResults' must be a multi-arm stage results object (is ", .getClassName(stageResults), ")"
        )
    }

    if (!.isMultiArmStageResults(stageResults)) {
        stop(
            C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT,
            "'stageResults' must be a multi-arm object (is ", .getClassName(stageResults), ")"
        )
    }
}

.assertIsStageResultsNonMultiHypotheses <- function(stageResults) {
    if (inherits(stageResults, "StageResults") && .isMultiArmStageResults(stageResults)) {
        stop(
            C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT,
            "'stageResults' must be a non-multi-arm object (is ", .getClassName(stageResults), ")"
        )
    }

    if (inherits(stageResults, "StageResults") && .isEnrichmentStageResults(stageResults)) {
        stop(
            C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT,
            "'stageResults' must be a non-enrichment object (is ", .getClassName(stageResults), ")"
        )
    }

    allowedClasses <- c(
        "StageResultsMeans",
        "StageResultsRates",
        "StageResultsSurvival"
    )
    if (!(.getClassName(stageResults) %in% allowedClasses)) {
        stop(
            C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "'stageResults' must be an instance of ",
            .arrayToString(allowedClasses, vectorLookAndFeelEnabled = FALSE),
            " (is '", .getClassName(stageResults), "')"
        )
    }
}

.assertIsDatasetNonMultiHypotheses <- function(dataInput) {
    if (.isMultiArmDataset(dataInput)) {
        stop(
            C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT,
            "'dataInput' must be a non-multi-arm dataset (has ", dataInput$getNumberOfGroups(), " treatment arms)"
        )
    }
    if (.isEnrichmentDataset(dataInput)) {
        stop(
            C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT,
            "'dataInput' must be a non-enrichment dataset (has ", dataInput$getNumberOfSubsets(), " subsets)"
        )
    }
}

.assertIsAnalysisResults <- function(analysisResults) {
    if (!inherits(analysisResults, "AnalysisResults")) {
        stop(
            C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "'analysisResults' must be a valid 'AnalysisResults' object ",
            " (is '", .getClassName(analysisResults), "')"
        )
    }
}

.isValidIntersectionTestMultiArm <- function(intersectionTest) {
    return(!is.null(intersectionTest) && length(intersectionTest) == 1 && !is.na(intersectionTest) &&
        is.character(intersectionTest) && intersectionTest %in% C_INTERSECTION_TESTS_MULTIARMED)
}

.getCorrectedIntersectionTestMultiArmIfNecessary <- function(design, intersectionTest, userFunctionCallEnabled = TRUE) {
    .assertIsCharacter(intersectionTest, "intersectionTest")
    intersectionTest <- intersectionTest[1]
    if (.isTrialDesignConditionalDunnett(design) && intersectionTest != "Dunnett") {
        if (userFunctionCallEnabled) {
            message <- paste0("Intersection test '", intersectionTest, "' ")
            if (!.isValidIntersectionTestMultiArm(intersectionTest)) {
                message <- paste0(message, "is invalid, ")
            }
            message <- paste0(message, "will be ignored")
            message <- paste0(message, ifelse(!.isValidIntersectionTestMultiArm(intersectionTest), ", ", " "))
            message <- paste0(
                message, "and 'Dunnett' will be used instead ",
                "because conditional Dunnett test was specified as design"
            )
            warning(message, call. = FALSE)
        }
        intersectionTest <- "Dunnett"
    }
    return(intersectionTest)
}

.assertIsValidIntersectionTestMultiArm <- function(design, intersectionTest) {
    .assertIsCharacter(intersectionTest, "intersectionTest")
    intersectionTest <- intersectionTest[1]
    if (!.isValidIntersectionTestMultiArm(intersectionTest)) {
        stop(
            C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "'intersectionTest' (", intersectionTest, ") must be one of ",
            .arrayToString(C_INTERSECTION_TESTS_MULTIARMED, encapsulate = TRUE)
        )
    }
    if (.isTrialDesignConditionalDunnett(design) && intersectionTest != "Dunnett") {
        stop(
            C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "intersection test ('", intersectionTest, "') must be 'Dunnett' ",
            "because conditional Dunnett test was specified as design"
        )
    }
}

.isValidIntersectionTestEnrichment <- function(intersectionTest) {
    return(!is.null(intersectionTest) && length(intersectionTest) == 1 && !is.na(intersectionTest) &&
        is.character(intersectionTest) && intersectionTest %in% C_INTERSECTION_TESTS_ENRICHMENT)
}

.assertIsValidIntersectionTestEnrichment <- function(design, intersectionTest) {
    .assertIsCharacter(intersectionTest, "intersectionTest")
    intersectionTest <- intersectionTest[1]
    if (!.isValidIntersectionTestEnrichment(intersectionTest)) {
        stop(
            C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "'intersectionTest' (", intersectionTest, ") must be one of ",
            .arrayToString(C_INTERSECTION_TESTS_ENRICHMENT, encapsulate = TRUE)
        )
    }
    return(intersectionTest)
}

.ignoreParameterIfNotUsed <- function(paramName, paramValue, requirementLogical, requirementFailedReason,
        prefix = NA_character_) {
    if (all(is.na(paramValue)) || requirementLogical) {
        return(paramValue)
    }

    if (is.na(prefix) || trimws(prefix) == "") {
        prefix <- ""
    } else {
        prefix <- paste0(trimws(prefix), " ")
    }

    warning(prefix, "'", paramName, "' (", .arrayToString(paramValue), ") will be ignored because ",
        requirementFailedReason,
        call. = FALSE
    )
    return(NA_real_)
}

#
# This is a workaround for the following  R core bug:
#
# rCoreBugDemonstration <- function(stageX, ...) {
# 	result <- list(...); result$stageX <- stageX; return(result)
# }
# # bug: stage will be removed, stageX gets the value of stage
# rCoreBugDemonstration("A", stage = 1)
# # everything works as expected
# rCoreBugDemonstration("A", state = 1)
#
.stopInCaseOfIllegalStageDefinition <- function(stageResults, ...) {
    stage <- list(...)[["stage"]]
    if (is.null(stage) && is.numeric(stageResults) && stageResults %in% 1L:C_KMAX_UPPER_BOUND) {
        stage <- stageResults
    }
    if (!is.null(stage)) {
        stop(
            C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT,
            "'stage' (", stage, ") can only be defined in getStageResults() or getAnalysisResults()"
        )
    }
}

.stopInCaseOfIllegalStageDefinition2 <- function(...) {
    forbiddenStage <- .getOptionalArgument("stage", ...)
    if (!is.null(forbiddenStage)) {
        stop(
            C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT,
            "'stage' (", forbiddenStage, ") can only be defined in getStageResults() or getAnalysisResults()"
        )
    }
}

.assertIsValidTolerance <- function(tolerance) {
    .assertIsSingleNumber(tolerance, "tolerance")
    .assertIsInOpenInterval(tolerance, "tolerance", lower = 0, upper = 0.1)
}

.isValidVarianceOptionMultiArmed <- function(varianceOption) {
    return(!is.null(varianceOption) && length(varianceOption) == 1 && !is.na(varianceOption) &&
        is.character(varianceOption) && varianceOption %in% C_VARIANCE_OPTIONS_MULTIARMED)
}

.assertIsValidVarianceOptionMultiArmed <- function(design, varianceOption) {
    if (!.isValidVarianceOptionMultiArmed(varianceOption)) {
        stop(
            C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "'varianceOption' should be one of ",
            .arrayToString(C_VARIANCE_OPTIONS_MULTIARMED, encapsulate = TRUE)
        )
    }
    if (.isTrialDesignConditionalDunnett(design) && varianceOption != C_VARIANCE_OPTION_DUNNETT) {
        stop(
            C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT,
            "variance option ('", varianceOption, "') must be '", C_VARIANCE_OPTION_DUNNETT, "' ",
            "because conditional Dunnett test was specified as design"
        )
    }
}

.isValidVarianceOptionEnrichment <- function(varianceOption) {
    return(!is.null(varianceOption) && length(varianceOption) == 1 && !is.na(varianceOption) &&
        is.character(varianceOption) && varianceOption %in% C_VARIANCE_OPTIONS_ENRICHMENT)
}

.assertIsValidVarianceOptionEnrichment <- function(design, varianceOption) {
    if (!.isValidVarianceOptionEnrichment(varianceOption)) {
        stop(
            C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "'varianceOption' should be one of ",
            .arrayToString(C_VARIANCE_OPTIONS_ENRICHMENT, encapsulate = TRUE)
        )
    }
}


.assertIsValidSummaryIntervalFormat <- function(intervalFormat) {
    .assertIsSingleCharacter(intervalFormat, "intervalFormat") # "[%s; %s]"
    if (!grepl("^[^%]*%s[^%]*%s[^%]*$", intervalFormat)) {
        stop(
            C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT,
            "'intervalFormat' (", intervalFormat, ") has an invalid format; ",
            "the control character %s must appear exactly twice; ",
            "to change it use 'options(\"rpact.summary.intervalFormat\" = \"[%s; %s]\")'"
        )
    }
}

.isSpecialPlotShowSourceArgument <- function(showSource) {
    return(is.character(showSource) && showSource %in% C_PLOT_SHOW_SOURCE_ARGUMENTS)
}

.assertIsValidTypeOfSelection <- function(typeOfSelection, rValue, epsilonValue, activeArms) {
    .assertIsCharacter(typeOfSelection, "typeOfSelection")
    typeOfSelection <- typeOfSelection[1]
    if (typeOfSelection == "rbest") {
        typeOfSelection <- "rBest"
    }
    if (!(typeOfSelection %in% C_TYPES_OF_SELECTION)) {
        stop(
            C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "'typeOfSelection' (", typeOfSelection, ") must be one of ",
            .arrayToString(C_TYPES_OF_SELECTION, encapsulate = TRUE)
        )
    }

    if (typeOfSelection == "rBest") {
        .assertIsSingleNumber(rValue, "rValue", naAllowed = FALSE, noDefaultAvailable = TRUE)
        if (activeArms == 1) {
            warning("'typeOfSelection' (\"", typeOfSelection, "\") will be ignored ",
                "because 'activeArms' or 'populations' = 1",
                call. = FALSE
            )
        } else if (rValue > activeArms) {
            warning("'rValue' (", rValue, ") is larger than activeArms or populations ",
                "(", activeArms, ") and will be ignored",
                call. = FALSE
            )
        }
    } else if (!is.na(rValue)) {
        warning("'rValue' (", rValue, ") will be ignored because 'typeOfSelection' != \"rBest\"", call. = FALSE)
    }

    if (typeOfSelection == "epsilon") {
        .assertIsSingleNumber(epsilonValue, "epsilonValue", naAllowed = FALSE, noDefaultAvailable = TRUE)
        .assertIsInClosedInterval(epsilonValue, "epsilonValue", lower = 0, upper = NULL, naAllowed = TRUE)
    } else if (!is.na(epsilonValue)) {
        warning("'epsilonValue' (", epsilonValue, ") will be ignored ",
            "because 'typeOfSelection' != \"epsilon\"",
            call. = FALSE
        )
    }

    return(typeOfSelection)
}

.assertIsValidSuccessCriterion <- function(successCriterion) {
    .assertIsCharacter(successCriterion, "successCriterion")
    successCriterion <- successCriterion[1]
    if (!(successCriterion %in% C_SUCCESS_CRITERIONS)) {
        stop(
            C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "'successCriterion' (", successCriterion, ") must be one of ",
            .arrayToString(C_SUCCESS_CRITERIONS, encapsulate = TRUE)
        )
    }
    return(successCriterion)
}

.assertIsValidEffectMeasure <- function(effectMeasure) {
    .assertIsCharacter(effectMeasure, "effectMeasure")
    effectMeasure <- effectMeasure[1]
    if (!(effectMeasure %in% C_EFFECT_MEASURES)) {
        stop(
            C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "'effectMeasure' (", effectMeasure, ") must be one of ",
            .arrayToString(C_EFFECT_MEASURES, encapsulate = TRUE)
        )
    }
    return(effectMeasure)
}

.assertIsValidMatrix <- function(x, argumentName, ...,
        expectedNumberOfColumns = NA_integer_, naAllowed = FALSE, returnSingleValueAsMatrix = FALSE) {
    if (missing(x) || is.null(x) || length(x) == 0) {
        stop(C_EXCEPTION_TYPE_MISSING_ARGUMENT, "'", argumentName, "' must be a valid matrix")
    }

    if (returnSingleValueAsMatrix && !is.matrix(x) && (is.numeric(x) || is.character(x) || is.logical(x))) {
        if (length(x) == 1) {
            x <- matrix(x)
        } else if (length(x) > 1 && !is.na(expectedNumberOfColumns)) {
            if (length(x) %% expectedNumberOfColumns != 0) {
                stop(
                    C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "the length of '", argumentName, "' (", .arrayToString(x),
                    ") must be a divisor or a multiple ", expectedNumberOfColumns
                )
            }

            x <- matrix(x, ncol = expectedNumberOfColumns)
        }
    }

    if (!is.matrix(x)) {
        stop(C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "'", argumentName, "' (", .getClassName(x), ") must be a valid matrix")
    }

    if (!naAllowed && any(is.na(x))) {
        stop(C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "'", argumentName, "' (", .arrayToString(x), ") must not contain NA's")
    }

    if (!is.numeric(x)) {
        stop(
            C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "'", argumentName, "' (",
            .arrayToString(x), ") must be a valid numeric matrix"
        )
    }

    if (!is.na(expectedNumberOfColumns) && ncol(x) != expectedNumberOfColumns) {
        stop(
            C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "'", argumentName, "' (",
            .arrayToString(x), ") must be a numeric matrix with ", expectedNumberOfColumns, " columns"
        )
    }

    return(invisible(x))
}

.assertIsValidDecisionMatrix <- function(decisionMatrix, kMax) {
    .assertIsValidMatrix(decisionMatrix, "decisionMatrix", naAllowed = FALSE)
    if (!(nrow(decisionMatrix) %in% c(2, 4))) {
        stop(C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "'decisionMatrix' must have two or four rows")
    }
    if (ncol(decisionMatrix) != kMax) {
        stop(
            C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "'decisionMatrix' must have 'kMax' ",
            "(= length(informationRates) = ", kMax, ") columns"
        )
    }
    if (any(decisionMatrix[2:nrow(decisionMatrix), ] < decisionMatrix[1:(nrow(decisionMatrix) - 1), ])) {
        stop(C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "'decisionMatrix' needs to be increasing in each column")
    }
}

.assertIsValidTypeOfShape <- function(typeOfShape) {
    .assertIsCharacter(typeOfShape, "typeOfShape")
    typeOfShape <- typeOfShape[1]
    if (!(typeOfShape %in% C_TYPES_OF_SHAPE)) {
        stop(
            C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "'typeOfShape' (", typeOfShape, ") must be one of ",
            .arrayToString(C_TYPES_OF_SHAPE, encapsulate = TRUE)
        )
    }
    return(typeOfShape)
}

.assertIsValidEffectMatrixMeans <- function(typeOfShape, effectMatrix, muMaxVector, gED50, gMax, slope) {
    if (typeOfShape == "userDefined") {
        effectMatrix <- .assertIsValidMatrix(effectMatrix, "effectMatrix",
            expectedNumberOfColumns = gMax, naAllowed = FALSE, returnSingleValueAsMatrix = TRUE
        )

        .assertIsNumericVector(muMaxVector, "muMaxVector", naAllowed = TRUE)
        if (!all(is.na(muMaxVector)) && !identical(muMaxVector, C_ALTERNATIVE_POWER_SIMULATION_DEFAULT)) {
            warning("'muMaxVector' (", .arrayToString(muMaxVector),
                ") will be ignored because it will be set to first column of 'effectMatrix'",
                call. = FALSE
            )
        }
    } else if (!is.null(effectMatrix)) {
        warning("'effectMatrix' will be ignored because 'typeOfShape' is defined as '", typeOfShape, "'", call. = FALSE)
    }

    if (typeOfShape == "sigmoidEmax") {
        .assertIsNumericVector(muMaxVector, "muMaxVector", naAllowed = FALSE, noDefaultAvailable = TRUE)
        .assertIsSingleNumber(gED50, "gED50", naAllowed = FALSE, noDefaultAvailable = TRUE)
        effectMatrix <- matrix(muMaxVector, nrow = length(muMaxVector), ncol = 1) %*%
            matrix((1:gMax)^slope / (gED50^slope + (1:gMax)^slope), nrow = 1, ncol = gMax)
        return(effectMatrix)
    }

    if (!is.null(gED50) && !is.na(gED50)) {
        warning("'gED50' (", gED50, ") will be ignored because 'typeOfShape' is defined as '", typeOfShape, "'", call. = FALSE)
    }

    if (typeOfShape == "linear") {
        .assertIsNumericVector(muMaxVector, "muMaxVector", naAllowed = FALSE, noDefaultAvailable = TRUE)
        effectMatrix <- matrix(muMaxVector, nrow = length(muMaxVector), ncol = 1) %*%
            matrix((1:gMax) / gMax, nrow = 1, ncol = gMax)
    }

    if (!is.null(slope) && !is.na(slope) && slope != 1) {
        warning("'slope' (", slope, ") will be ignored because 'typeOfShape' is defined as '", typeOfShape, "'", call. = FALSE)
    }

    return(effectMatrix)
}

.assertIsValidEffectMatrixRates <- function(typeOfShape, effectMatrix, piMaxVector, piControl, gED50, gMax, slope) {
    if (typeOfShape == "userDefined") {
        effectMatrix <- .assertIsValidMatrix(effectMatrix, "effectMatrix",
            expectedNumberOfColumns = gMax, naAllowed = FALSE, returnSingleValueAsMatrix = TRUE
        )
        .assertIsInOpenInterval(effectMatrix, "effectMatrix", 0, 1, naAllowed = FALSE)

        .assertIsNumericVector(piMaxVector, "piMaxVector", naAllowed = TRUE)
        if (!all(is.na(piMaxVector)) && !identical(piMaxVector, C_PI_1_DEFAULT)) {
            warning("'piMaxVector' (", .arrayToString(piMaxVector),
                ") will be ignored because it will be set to first column of 'effectMatrix'",
                call. = FALSE
            )
        }
    } else if (!is.null(effectMatrix)) {
        warning("'effectMatrix' will be ignored because 'typeOfShape' is defined as '", typeOfShape, "'", call. = FALSE)
    }

    if (typeOfShape == "sigmoidEmax") {
        .assertIsNumericVector(piMaxVector, "piMaxVector", naAllowed = FALSE, noDefaultAvailable = TRUE)
        .assertIsInOpenInterval(piMaxVector, "piMaxVector", 0, 1, naAllowed = FALSE)
        .assertIsSingleNumber(gED50, "gED50", naAllowed = FALSE, noDefaultAvailable = TRUE)
        effectMatrix <- matrix(piMaxVector, nrow = length(piMaxVector), ncol = 1) %*%
            matrix((1:gMax)^slope / (gED50^slope + (1:gMax)^slope), nrow = 1, ncol = gMax)
        return(effectMatrix)
    }

    if (!is.null(gED50) && !is.na(gED50)) {
        warning("'gED50' (", gED50, ") will be ignored because 'typeOfShape' is defined as '", typeOfShape, "'", call. = FALSE)
    }

    if (typeOfShape == "linear") {
        .assertIsNumericVector(piMaxVector, "piMaxVector", naAllowed = FALSE, noDefaultAvailable = TRUE)
        .assertIsInOpenInterval(piMaxVector, "piMaxVector", 0, 1, naAllowed = FALSE)
        .assertIsSingleNumber(piControl, "piControl", naAllowed = FALSE, noDefaultAvailable = TRUE)
        .assertIsInOpenInterval(piControl, "piControl", 0, 1, naAllowed = FALSE)
        effectMatrix <- piControl + matrix(piMaxVector - piControl, nrow = length(piMaxVector), ncol = 1) %*%
            matrix((1:gMax) / gMax, nrow = 1, ncol = gMax)
    }

    if (!is.null(slope) && !is.na(slope) && slope != 1) {
        warning("'slope' (", slope, ") will be ignored because 'typeOfShape' is defined as '", typeOfShape, "'", call. = FALSE)
    }

    return(effectMatrix)
}

.assertIsValidEffectMatrixSurvival <- function(typeOfShape, effectMatrix, omegaMaxVector, gED50, gMax, slope) {
    if (typeOfShape == "userDefined") {
        effectMatrix <- .assertIsValidMatrix(effectMatrix, "effectMatrix",
            expectedNumberOfColumns = gMax, naAllowed = FALSE, returnSingleValueAsMatrix = TRUE
        )
        .assertIsInOpenInterval(effectMatrix, "effectMatrix", 0, NULL, naAllowed = FALSE)

        .assertIsNumericVector(omegaMaxVector, "omegaMaxVector", naAllowed = TRUE)
        if (!all(is.na(omegaMaxVector)) && !identical(omegaMaxVector, C_RANGE_OF_HAZARD_RATIOS_DEFAULT)) {
            warning("'omegaMaxVector' (", .arrayToString(omegaMaxVector),
                ") will be ignored because it will be set to first column of 'effectMatrix'",
                call. = FALSE
            )
        }
    } else if (!is.null(effectMatrix)) {
        warning("'effectMatrix' will be ignored because 'typeOfShape' is defined as '", typeOfShape, "'", call. = FALSE)
    }

    if (typeOfShape == "sigmoidEmax") {
        .assertIsNumericVector(omegaMaxVector, "omegaMaxVector", naAllowed = FALSE, noDefaultAvailable = TRUE)
        .assertIsInOpenInterval(omegaMaxVector, "omegaMaxVector", 0, NULL, naAllowed = FALSE)
        .assertIsSingleNumber(gED50, "gED50", naAllowed = FALSE, noDefaultAvailable = TRUE)
        effectMatrix <- matrix(omegaMaxVector - 1, nrow = length(omegaMaxVector), ncol = 1) %*%
            matrix((1:gMax)^slope / (gED50^slope + (1:gMax)^slope), nrow = 1, ncol = gMax) + 1

        return(effectMatrix)
    }

    if (!is.null(gED50) && !is.na(gED50)) {
        warning("'gED50' (", gED50, ") will be ignored because 'typeOfShape' is defined as '", typeOfShape, "'", call. = FALSE)
    }

    if (typeOfShape == "linear") {
        .assertIsNumericVector(omegaMaxVector, "omegaMaxVector", naAllowed = FALSE, noDefaultAvailable = TRUE)
        .assertIsInOpenInterval(omegaMaxVector, "omegaMaxVector", 0, NULL, naAllowed = FALSE)
        effectMatrix <- matrix(omegaMaxVector - 1, nrow = length(omegaMaxVector), ncol = 1) %*%
            matrix((1:gMax) / gMax, nrow = 1, ncol = gMax) + 1
    }

    if (!is.null(slope) && !is.na(slope) && slope != 1) {
        warning("'slope' (", slope, ") will be ignored because 'typeOfShape' is defined as '", typeOfShape, "'", call. = FALSE)
    }

    return(effectMatrix)
}

.assertIsValidPlannedSubjects <- function(plannedSubjects, kMax) {
    .assertIsIntegerVector(plannedSubjects, "plannedSubjects", validateType = FALSE)
    if (length(plannedSubjects) != kMax) {
        stop(
            C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT,
            "'plannedSubjects' (", .arrayToString(plannedSubjects),
            ") must have length 'kMax' (", kMax, ")"
        )
    }
    .assertIsInClosedInterval(plannedSubjects, "plannedSubjects", lower = 1, upper = NULL)
    .assertValuesAreStrictlyIncreasing(plannedSubjects, "plannedSubjects")
}

.isAlphaSpendingDesign <- function(design) {
    if (!.isTrialDesignInverseNormalOrGroupSequential(design)) {
        return(FALSE)
    }

    return(grepl("^as", design$typeOfDesign))
}

.isDelayedInformationEnabled <- function(..., design = NULL, delayedInformation = NULL) {
    if (is.null(design) && is.null(delayedInformation)) {
        stop(C_EXCEPTION_TYPE_MISSING_ARGUMENT, "either 'design' or 'delayedInformation' must be specified")
    }

    if (!is.null(design)) {
        if (!.isTrialDesignInverseNormalOrGroupSequential(design)) {
            return(FALSE)
        }

        delayedInformation <- design[["delayedInformation"]]
    }
    if (is.null(delayedInformation)) {
        return(FALSE)
    }

    return(all(!is.na(delayedInformation)) && any(delayedInformation >= 1e-03))
}

Try the rpact package in your browser

Any scripts or data that you put into this service are public.

rpact documentation built on July 9, 2023, 6:30 p.m.