Nothing
#######################################################################################################################
# Function: GeneratePatients.
# Argument: Design parameter, outcome parameter, sample id and number of patients or events to generate.
# Description: Generates data frames of simulated patients. This function is used in the CreateDataStack function.
GeneratePatients = function(current.design.parameter, current.outcome, current.sample.id, number){
# Generate a set of outcome variables
current.outcome.call = list(number, current.outcome$par)
current.outcome.variables = as.matrix(do.call(current.outcome$dist, list(current.outcome.call)))
colnames(current.outcome.variables) = paste0("outcome",1:ncol(current.outcome.variables))
# Generate a set of design variables
if (!is.null(current.design.parameter)){
# Compute patient start times
# Uniform patient start times
if (current.design.parameter$enroll.dist == "UniformDist") {
# Uniform distribution over [0, 1]
enroll.par = list(number, list(max = 1))
# Uniform distribution is expanded over the enrollment period
patient.start.time = current.design.parameter$enroll.period * sort(unlist(lapply(list(enroll.par), "UniformDist")))
} else if (current.design.parameter$enroll.dist == "BetaDist") {
# Beta patient start times
# Beta distribution parameters
enroll.par = list(number, current.design.parameter$enroll.dist.par)
# Beta distribution is expanded over the enrollment period
patient.start.time = current.design.parameter$enroll.period * sort(unlist(lapply(list(enroll.par), "BetaDist")))
} else {
# Non-uniform patient start times
# List of enrollment parameters
enroll.par = list(number, current.design.parameter$enroll.dist.par)
patient.start.time = sort(unlist(lapply(list(enroll.par), current.design.parameter$enroll.dist)))
}
# Patient start times are truncated at the end of the enrollment period
patient.start.time = pmin(patient.start.time, current.design.parameter$enroll.period)
# Compute patient end times
# Patient end times
if (!is.na(current.design.parameter$followup.period)) {
# In a design with a fixed follow-up (followup.period is specified), the patient end time
# is equal to the patient start time plus the fixed follow-up time
patient.end.time = patient.start.time + current.design.parameter$followup.period
}
if (!is.na(current.design.parameter$study.duration)) {
# In a design with a variable follow-up (study.duration is specified), the patient end time
# is equal to the end of the trial
patient.end.time = rep(current.design.parameter$study.duration, number)
}
# Compute patient dropout times (if the dropout distribution is specified) for the maximum sample size
if (!is.na(current.design.parameter$dropout.dist)) {
# Uniform patient dropout times
if (current.design.parameter$dropout.dist == "UniformDist") {
# The parameter corresponds to the proportion of dropout
# Generate Uniform distribution between 0 and 1/proportion
dropout.par = list(number, list(max = 1/current.design.parameter$dropout.dist.par$prop))
# Uniform distribution is expanded over the patient-specific periods
patient.dropout.time = patient.start.time + (patient.end.time - patient.start.time) *
unlist(lapply(list(dropout.par), "UniformDist"))
} else {
# Non-uniform patient dropout times
# List of dropout parameters
dropout.par = list(number, current.design.parameter$dropout.dist.par)
patient.dropout.time = patient.start.time +
unlist(lapply(list(dropout.par), current.design.parameter$dropout.dist))
}
# If the patient end time is greater than the patient dropout time, the patient end time
# is truncated, the patient dropout indicator is set to TRUE.
patient.dropout.indicator = (patient.end.time >= patient.dropout.time)
patient.end.time = pmin(patient.end.time, patient.dropout.time)
} else {
# No dropout distribution is specified
patient.dropout.time = rep(NA, number)
patient.dropout.indicator = rep(FALSE, number)
}
# Patient censore will be get later on in the function according to the outcome variable
patient.censor.indicator = rep(FALSE, number)
# Create a data frame and save it
current.design.variables = t(rbind(patient.start.time,
patient.end.time,
patient.dropout.time,
patient.dropout.indicator,
patient.censor.indicator))
} else if (is.null(current.design.parameter)){
# No design parameters are specified in the data model
patient.start.time = rep(NA, number)
patient.end.time = rep(NA, number)
patient.dropout.time = rep(NA, number)
patient.dropout.indicator = rep(FALSE, number)
patient.censor.indicator = rep(FALSE, number)
# Create a data frame and save it
current.design.variables = t(rbind(patient.start.time,
patient.end.time,
patient.dropout.time,
patient.dropout.indicator,
patient.censor.indicator))
}
colnames(current.design.variables) = c("patient.start.time",
"patient.end.time",
"patient.dropout.time",
"patient.dropout.indicator",
"patient.censor.indicator")
# Create the list with the data frame for the current design and outcome parameter and for each outcome
current.design.outcome.variables = list()
# Create the censor indicator for each outcome
for (outcome.index in 1:length(current.outcome$type)){
current.outcome.type = current.outcome$type[outcome.index]
patient.end.time = current.design.variables[,"patient.end.time"]
patient.start.time = current.design.variables[,"patient.start.time"]
patient.dropout.time = current.design.variables[,"patient.dropout.time"]
patient.censor.indicator = current.design.variables[,"patient.censor.indicator"]
outcome = current.outcome.variables[,paste0("outcome",outcome.index)]
# Compute patient censor times for the analysis data sample if the current outcome type is "event"
if (current.outcome.type == "event") {
# Dropout distribution is specified
if (!all(is.na(patient.dropout.time))) {
# Outcome variable is truncated and the patient censor indicator is set to TRUE
# if the outcome variable is greater than the patient dropout time (relative to the patient start time)
patient.censor.indicator = patient.censor.indicator | (outcome >= patient.dropout.time - patient.start.time)
outcome = pmin(outcome, patient.dropout.time - patient.start.time)
}
# Enrollment distribution is specified
if (!all(is.na(patient.start.time))) {
# Outcome variable is truncated and the patient censor indicator is set to TRUE
# if the outcome variable is greater than the patient end time (relative to the patient start time)
patient.censor.indicator = patient.censor.indicator | (outcome >= patient.end.time - patient.start.time)
outcome = pmin(outcome, patient.end.time - patient.start.time)
# Patient end time (relative to the patient start time) is set to the outcome variable if the
# patient experience the event (that is, the patient censor indicator is FALSE)
patient.end.time = (!patient.censor.indicator) * (patient.start.time + outcome) +
(patient.censor.indicator) * patient.end.time
}
} else {
# Current outcome type is "standard"
# Dropout distribution is specified
if (!all(is.na(patient.dropout.time))) {
# Outcome variable is set to NA if the patient dropout indicator is TRUE
outcome[patient.dropout.indicator] = NA
}
patient.censor.indicator = rep(FALSE, length(patient.censor.indicator))
}
# Create a data frame for the current sample and outcome
df = as.data.frame(t(rbind(outcome,
patient.start.time,
patient.end.time,
patient.dropout.time,
patient.censor.indicator)))
colnames(df) = c("outcome",
"patient.start.time",
"patient.end.time",
"patient.dropout.time",
"patient.censor.indicator")
current.design.outcome.variables[[outcome.index]] = list(id = current.sample.id[outcome.index],
outcome.type = current.outcome.type,
data = df)
}
return(current.design.outcome.variables)
} # End of GeneratePatients function
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.