Nothing
######################################################################################################################
# Function: CreateAnalysisStructure.
# Argument: Analysis model.
# Description: This function is based on the old analysis_model_extract function. It performs error checks in the analysis model
# and creates an "analysis structure", which is an internal representation of the original analysis model used by all other Mediana functions.
CreateAnalysisStructure = function(analysis.model) {
# Check the general set
if (is.null(analysis.model$tests) & is.null(analysis.model$statistics))
stop("Analysis model: At least one test or statistic must be specified.")
# General set of analysis model parameters
# Extract interim analysis parameters
if (!is.null(analysis.model$general$interim.analysis)) {
interim.looks = analysis.model$general$interim.analysis$interim.looks
if (!(interim.looks$parameter %in% c("sample.size", "event", "time")))
stop("Analysis model: Parameter in the interim analysis specifications must be sample.size, event or time.")
interim.analysis = list(interim.looks = interim.looks)
} else {
interim.analysis = NULL
}
# Extract test-specific parameters
if (!is.null(analysis.model$tests)) {
# Number of tests in the analysis model
n.tests = length(analysis.model$tests)
# List of tests (id, statistical method, sample list, parameters)
test = list()
for (i in 1:n.tests) {
# Test IDs
if (is.null(analysis.model$tests[[i]]$id))
stop("Analysis model: IDs must be specified for all tests.") else id = analysis.model$tests[[i]]$id
# List of samples
if (is.null(analysis.model$tests[[i]]$samples))
stop("Analysis model: Samples must be specified for all tests.") else samples = analysis.model$tests[[i]]$samples
# Statistical method
method = analysis.model$test[[i]]$method
if (!exists(method)) {
stop(paste0("Analysis model: Statistical method function '", method, "' does not exist."))
} else if (!is.function(get(as.character(method), mode = "any"))) {
stop(paste0("Analysis model: Statistical method function '", method, "' does not exist."))
}
# Test parameters (optional)
if (is.null(analysis.model$tests[[i]]$par)) par = NA
else par = analysis.model$tests[[i]]$par
test[[i]] = list(id = id, method = method, samples = samples, par = par)
}
# Check if id is uniquely defined
if (any(table(unlist(lapply(test,function(list) list$id)))>1))
stop("Analysis model: Tests IDs must be uniquely defined.")
} else {
# No tests are specified
test = NULL
}
# Extract statistic-specific parameters
if (!is.null(analysis.model$statistics)) {
# Number of statistics in the analysis model
n.statistics = length(analysis.model$statistics)
# List of statistics (id, statistical method, sample list, parameters)
statistic = list()
for (i in 1:n.statistics) {
# Statistic IDs
if (is.null(analysis.model$statistic[[i]]$id))
stop("Analysis model: IDs must be specified for all statistics.") else id = analysis.model$statistic[[i]]$id
# List of samples
if (is.null(analysis.model$statistic[[i]]$samples))
stop("Analysis model: Samples must be specified for all statistics.") else samples = analysis.model$statistic[[i]]$samples
# Statistical method
method = analysis.model$statistic[[i]]$method
if (!exists(method)) {
stop(paste0("Analysis model: Statistical method function '", method, "' does not exist."))
} else if (!is.function(get(as.character(method), mode = "any"))) {
stop(paste0("Analysis model: Statistical method function '", method, "' does not exist."))
}
if (is.null(analysis.model$statistic[[i]]$par)) par = NA else par = analysis.model$statistic[[i]]$par
statistic[[i]] = list(id = id, method = method, samples = samples, par = par)
}
# Check if id is uniquely defined
if (any(table(unlist(lapply(statistic,function(list) list$id)))>1))
stop("Analysis model: Statistic IDs must be uniquely defined.")
} else {
# No statistics are specified
statistic = NULL
}
# Extract parameters of multiplicity adjustment methods
# List of multiplicity adjustments (procedure, parameters, tests)
mult.adjust = list(list())
# Number of multiplicity adjustment methods
if (is.null(analysis.model$general$mult.adjust)) {
# No multiplicity adjustment is specified
mult.adjust = NULL
} else {
n.mult.adjust = length(analysis.model$general$mult.adjust)
for (i in 1:n.mult.adjust) {
mult.adjust.temp = list()
# Number of multiplicity adjustments within each mult.adj scenario
n.mult.adj.sc=length(analysis.model$general$mult.adjust[[i]])
for (j in 1:n.mult.adj.sc){
proc = analysis.model$general$mult.adjust[[i]][[j]]$proc
if (is.na(proc) | is.null(analysis.model$general$mult.adjust[[i]][[j]]$par)) par = NA else par = analysis.model$general$mult.adjust[[i]][[j]]$par
if (is.null(analysis.model$general$mult.adjust[[i]][[j]]$tests)) {
tests = lapply(test, function(list) list$id)
} else {
tests = analysis.model$general$mult.adjust[[i]][[j]]$tests
}
# If the multiplicity adjustment procedure is specified, check if it exists
if (!is.na(proc)) {
if (!exists(proc)) {
stop(paste0("Analysis model: Multiplicity adjustment procedure function '", proc, "' does not exist."))
} else if (!is.function(get(as.character(proc), mode = "any"))) {
stop(paste0("Analysis model: Multiplicity adjustment procedure function '", proc, "' does not exist."))
}
}
# Check if tests defined in the multiplicity adjustment exist (defined in the test list)
temp_list = lapply(lapply(tests,function(l1,l2) l1 %in% l2, lapply(test, function(list) list$id)), function(l) any(l == FALSE))
if (!is.na(proc) & any(temp_list == TRUE))
stop(paste0("Analysis model: Multiplicity adjustment procedure test has not been specified in the test-specific model."))
mult.adjust.temp[[j]] = list(proc = proc, par = par, tests = tests)
}
mult.adjust[[i]] = mult.adjust.temp
# Check if tests defined in multiplicity adjustment is defined in one and only one multiplicity adjustment
if (any(table(unlist(lapply(mult.adjust[[i]],function(list) list$tests)))>1))
stop(paste0("Analysis model: Multiplicity adjustment procedure test has been specified in more than one multiplicity adjustment."))
}
}
# Create the analysis structure
analysis.structure = list(description = "analysis.structure",
test = test,
statistic = statistic,
mult.adjust = mult.adjust,
interim.analysis = interim.analysis)
return(analysis.structure)
}
# End of CreateAnalysisStructure
Any scripts or data that you put into this service are public.
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.