Nothing
R/function.Make_Conclusions_Effect_size.R
In EQUALSTATS: Algorithm Driven Statistical Analysis for Researchers without Coding Skills
Defines functions
function.Make_Conclusions_Effect_size
Documented in
function.Make_Conclusions_Effect_size
function.Make_Conclusions_Effect_size <- function(Predefined_lists, rv){
# Lists
plan <- {cbind.data.frame(
analysis_number = paste0("AN", formatC((length(rv$plan) + 1), width = 4, format = "d", flag = 0)),
first_menu_choice = rv$first_menu_choice,
second_menu_choice = rv$second_menu_choice,
entry_1 = paste0(rv$entry[[1]], collapse = "%_%"),
entry_2 = paste0(rv$entry[[2]], collapse = "%_%"),
entry_3 = paste0(rv$entry[[3]], collapse = "%_%"),
entry_4 = paste0(rv$entry[[4]], collapse = "%_%"),
entry_5 = paste0(rv$entry[[5]], collapse = "%_%"),
entry_6 = paste0(rv$entry[[6]], collapse = "%_%"),
entry_7 = paste0(rv$entry[[7]], collapse = "%_%"),
entry_8 = paste0(rv$entry[[8]], collapse = "%_%"),
entry_9 = paste0(rv$entry[[9]], collapse = "%_%"),
entry_10 = paste0(rv$entry[[10]], collapse = "%_%"),
entry_11 = paste0(rv$entry[[11]], collapse = "%_%"),
entry_12 = paste0(rv$entry[[12]], collapse = "%_%"),
entry_13 = paste0(rv$entry[[13]], collapse = "%_%"),
entry_14 = paste0(rv$entry[[14]], collapse = "%_%"),
entry_15 = paste0(rv$entry[[15]], collapse = "%_%"),
same_row_different_row = ""
)}
selections <- {paste0(
'<b>entry_1: </b>', paste0(rv$entry[[1]], collapse = "; "), '<br>',
'<b>entry_2: </b>', paste0(rv$entry[[2]], collapse = "; "), '<br>',
'<b>entry_3: </b>', paste0(rv$entry[[3]], collapse = "; "), '<br>',
'<b>entry_4: </b>', paste0(rv$entry[[4]], collapse = "; "), '<br>',
'<b>entry_5: </b>', paste0(rv$entry[[5]], collapse = "; "), '<br>',
'<b>entry_6: </b>', paste0(rv$entry[[6]], collapse = "; "), '<br>',
'<b>entry_7: </b>', paste0(rv$entry[[7]], collapse = "; "), '<br>',
'<b>entry_8: </b>', paste0(rv$entry[[8]], collapse = "; "), '<br>',
'<b>entry_9: </b>', paste0(rv$entry[[9]], collapse = "; "), '<br>',
'<b>entry_10: </b>', paste0(rv$entry[[10]], collapse = "; "), '<br>',
'<b>entry_11: </b>', paste0(rv$entry[[11]], collapse = "; "), '<br>',
'<b>entry_12: </b>', paste0(rv$entry[[12]], collapse = "; "), '<br>'
)}
code <- {paste0(
'# AN', formatC((length(rv$plan) + 1), width = 4, format = "d", flag = 0), '\n',
'rv$first_menu_choice <- "', rv$first_menu_choice, '"\n',
'rv$second_menu_choice <- ', ifelse(is.na(rv$second_menu_choice),NA,paste0('"',rv$second_menu_choice, '"')), '\n',
'rv$entry[[1]] <- ', rv$entry[[1]], '\n',
'rv$entry[[2]] <- ', rv$entry[[2]], '\n',
'rv$entry[[3]] <- ', rv$entry[[3]], '\n',
'rv$entry[[4]] <- ', rv$entry[[4]], '\n',
'rv$entry[[5]] <- ', rv$entry[[5]], '\n',
'rv$entry[[6]] <- ', rv$entry[[6]], '\n',
'rv$entry[[7]] <- "', rv$entry[[7]], '"\n',
'rv$entry[[8]] <- "', rv$entry[[8]], '"\n',
'rv$entry[[9]] <- "', rv$entry[[9]], '"\n',
'rv$entry[[10]] <- ', rv$entry[[10]], '\n',
'rv$entry[[11]] <- "', rv$entry[[11]], '"\n',
'rv$entry[[12]] <- "', rv$entry[[12]], '"\n',
'AN', formatC((length(rv$plan) + 1), width = 4, format = "d", flag = 0), '_results <- function.',rv$first_menu_choice,'(Predefined_lists, rv)', '\n',
if(length(rv$plan) == 0){
'if (TRUE %in% (AN0001_results$plots_list != "")) {invisible(file.rename(AN0001_results$plots_list, paste0(AN0001_results$plots_list,"_copy")))}
'
} else {
paste0(
'AN', formatC((length(rv$plan) + 1), width = 4, format = "d", flag = 0),'_results$results[2,1] <- "AN',formatC((length(rv$plan) + 1), width = 4, format = "d", flag = 0),'"', '\n',
'if (TRUE %in% (AN', formatC((length(rv$plan) + 1), width = 4, format = "d", flag = 0),'_results$plots_list != "")) {invisible(file.rename(AN', formatC((length(rv$plan) + 1), width = 4, format = "d", flag = 0),'_results$plots_list, str_replace_all(AN', formatC((length(rv$plan) + 1), width = 4, format = "d", flag = 0),'_results$plots_list, "/AN0001_", "/AN', formatC((length(rv$plan) + 1), width = 4, format = "d", flag = 0),'_")))}', '\n')
},
'write.table(x = AN', formatC((length(rv$plan) + 1), width = 4, format = "d", flag = 0),'_results$results, append = TRUE, file = paste0(rv$StorageFolder, "/results.csv"), sep = ",", row.names = FALSE, col.names = FALSE, na = "", quote = FALSE, qmethod = "double")', '\n'
)}
alpha_power <- data.frame(alpha = as.numeric(rv$entry[[11]]), power = as.numeric(rv$entry[[12]]))
if ((rv$entry[[7]] == "Intervention is better than comparator") | (rv$entry[[7]] == "Intervention is not worse than comparator")) {
alpha <- alpha_power$alpha*2
power <- alpha_power$power
} else if (rv$entry[[7]] == "Intervention is equivalent to the comparator") {
alpha <- alpha_power$alpha*2
power <- 1-((1-alpha_power$power)/2)
} else if (rv$entry[[7]] == "Intervention is better or worse than comparator") {
alpha <- alpha_power$alpha
power <- alpha_power$power
}
if (rv$entry[[8]] == "Dependent samples") {
type = "paired"
} else {
type = "two.sample"
}
if (rv$second_menu_choice == "Intervention study (continuous outcome)") {
desired_effect_size <- abs(rv$entry[[10]]/rv$entry[[2]])
observed_effect_size <- abs(rv$entry[[1]]/rv$entry[[2]])
if (desired_effect_size == 0) {desired_effect_size <- 0.01}
desired_mean_difference <- rv$entry[[10]]
sample_size_calculations <- suppressWarnings(try(cbind.data.frame(
`Desired mean difference` = desired_mean_difference,
`Observed mean difference` = abs(rv$entry[[1]]),
alpha_power,
`Sample size required (each group)` =
ceiling(pwr.t.test(n = NULL, d = desired_effect_size, sig.level = alpha, power = power, type = type)$n)
), silent = TRUE))
sample_size_calculations_observed <- suppressWarnings(try(lapply(1:nrow(alpha_power), function(z) {
ceiling(pwr.t.test(n = NULL, d = observed_effect_size, sig.level = alpha, power = power, type = type)$n)
}), silent = TRUE))
if (str_detect(sample_size_calculations[[1]][1], "Error")) {
sample_size_calculations <- cbind.data.frame(
`Desired mean difference` = desired_mean_difference,
`Observed mean difference` = abs(rv$entry[[1]]),
alpha_power,
`Sample size required (each group)` = "The standard deviation is too small compared to the desired difference"
)
adequate_power <- TRUE
} else {
sample_size_calculations$`Total sample size required` <- sample_size_calculations$`Sample size required (each group)`*2
adequate_power <- (sample_size_calculations$`Total sample size required` <= (rv$entry[[5]] + rv$entry[[6]]))
}
if (str_detect(sample_size_calculations_observed[[1]][1], "Error")) {
sample_size_calculations$`Total sample size required (based on observed difference)` <- "Unable to estimate the sample size based on observed difference. This is likely to be because of observed difference being too large or the standard deviation being too small."
adequate_power_observed <- TRUE
} else {
sample_size_calculations$`Total sample size required (based on observed difference)` <- sample_size_calculations_observed[[1]]*2
adequate_power_observed <- (sample_size_calculations$`Total sample size required (based on observed difference)` <= (rv$entry[[5]] + rv$entry[[6]]))
}
actual_difference <- rv$entry[[1]]
} else if (rv$second_menu_choice == "Intervention study (binary outcome)") {
proportion_in_intervention <- rv$entry[[2]] + ifelse(rv$entry[[9]] == "Higher values of the outcome (or more events) are better for the subject", rv$entry[[10]],- rv$entry[[10]])
if (proportion_in_intervention < 0) {proportion_in_intervention <- 0}
if (proportion_in_intervention > 1) {proportion_in_intervention <- 1}
desired_effect_size <- abs(ES.h(proportion_in_intervention, rv$entry[[2]]))
observed_effect_size <- abs(ES.h(rv$entry[[1]], rv$entry[[2]]))
if (desired_effect_size == 0) {desired_effect_size <- 0.01}
desired_difference_in_proportion <- rv$entry[[10]]
observed_difference_in_proportion <- abs(rv$entry[[1]] - rv$entry[[2]])
sample_size_calculations <- suppressWarnings(try(lapply(1:nrow(alpha_power), function(z) {
cbind.data.frame(
`Desired difference in proportion` = desired_difference_in_proportion,
`Observed difference in proportion` = observed_difference_in_proportion,
alpha_power[z,],
`Sample size required (each group)` =
if (rv$entry[[8]] == "Dependent samples") {
ceiling(pwr.t.test(n = NULL, d = desired_effect_size, sig.level = alpha[z], power = power[z], type = type)$n)
} else {
ceiling(pwr.2p.test(h=desired_effect_size, n = NULL, sig.level = alpha[z], power[z])$n)
}
)
}), silent = TRUE))
sample_size_calculations_observed <- suppressWarnings(try(lapply(1:nrow(alpha_power), function(z) {
if (rv$entry[[8]] == "Dependent samples") {
ceiling(pwr.t.test(n = NULL, d = observed_effect_size, sig.level = alpha[z], power = power[z], type = type)$n)
} else {
ceiling(pwr.2p.test(h=observed_effect_size, n = NULL, sig.level = alpha[z], power[z])$n)
}
}), silent = TRUE))
if (str_detect(sample_size_calculations[[1]][1], "Error")) {
sample_size_calculations <- cbind.data.frame(
`Desired difference in proportion` = desired_difference_in_proportion,
`Observed difference in proportion` = observed_difference_in_proportion,
alpha_power,
`Sample size required (each group)` = "The desired difference in proportion is too large"
)
adequate_power <- TRUE
} else {
sample_size_calculations <- do.call(rbind.data.frame, sample_size_calculations)
sample_size_calculations$`Total sample size required` <- sample_size_calculations$`Sample size required (each group)`*2
adequate_power <- (sample_size_calculations$`Total sample size required` <= (rv$entry[[5]] + rv$entry[[6]]))
}
if (str_detect(sample_size_calculations_observed[[1]][1], "Error")) {
sample_size_calculations$`Total sample size required (based on observed difference)` <- "Unable to estimate the sample size based on observed difference. This is likely to be because of observed difference being too large."
adequate_power_observed <- TRUE
} else {
sample_size_calculations$`Total sample size required (based on observed difference)` <- sample_size_calculations_observed[[1]]*2
adequate_power_observed <- (sample_size_calculations$`Total sample size required (based on observed difference)` <= (rv$entry[[5]] + rv$entry[[6]]))
}
actual_difference <- rv$entry[[1]] - rv$entry[[2]]
}
lci <- rv$entry[[3]]
uci <- rv$entry[[4]]
if (rv$entry[[7]] == "Intervention is better or worse than comparator") {
left_margin <- -(rv$entry[[10]])
right_margin <- rv$entry[[10]]
if (rv$entry[[9]] == "Higher values of the outcome (or more events) are better for the subject") {
left_margin_label <- "Intervention is worse to the left of this line"
right_margin_label <- "Intervention is better to the right of this line"
} else {
left_margin_label <- "Intervention is better to the left of this line"
right_margin_label <- "Intervention is worse to the right of this line"
}
if (((lci < left_margin) & (uci < left_margin)) | ((lci > right_margin) & (uci > right_margin))) {
if (rv$entry[[9]] == "Higher values of the outcome (or more events) are better for the subject") {
if (lci < left_margin) {
conclusion <- "The intervention was worse than the comparator."
} else {
conclusion <- "The intervention was better than the comparator."
}
} else {
if (lci < left_margin) {
conclusion <- "The intervention was better than the comparator."
} else {
conclusion <- "The intervention was worse than the comparator."
}
}
} else {
if (adequate_power == TRUE) {
conclusion <- "There was no important difference between the intervention and the comparator."
} else {
conclusion <- "There was no evidence of an important difference between the intervention and the comparator, but an important difference cannot be ruled out."
}
}
} else if (rv$entry[[7]] == "Intervention is better than comparator"){
if (rv$entry[[9]] == "Higher values of the outcome (or more events) are better for the subject") {
left_margin <- -Inf
right_margin <- rv$entry[[10]]
left_margin_label <- NA
right_margin_label <- "Intervention is better to the right of this line"
if (lci > right_margin) {
conclusion <- "The intervention was better than the comparator."
} else {
if (adequate_power == TRUE) {
conclusion <- "The intervention was not better than the comparator."
} else {
conclusion <- "There was no evidence that the intervention was better than the comparator, however, this cannot be be ruled out."
}
}
} else {
left_margin <- -(rv$entry[[10]])
right_margin <- Inf
left_margin_label <- "Intervention is better to the left of this line"
right_margin_label <- NA
if (uci < left_margin) {
conclusion <- "The intervention was better than the comparator."
} else {
if (adequate_power == TRUE) {
conclusion <- "The intervention was not better than the comparator."
} else {
conclusion <- "There was no evidence that the intervention was better than the comparator, however, this cannot be be ruled out."
}
}
}
} else if (rv$entry[[7]] == "Intervention is not worse than comparator") {
if (rv$entry[[9]] == "Higher values of the outcome (or more events) are better for the subject") {
left_margin <- -Inf
right_margin <- -(rv$entry[[10]])
left_margin_label <- NA
right_margin_label <- "Intervention is non-inferior to the right of this line"
if (lci > right_margin) {
conclusion <- "The intervention was non-inferior to the comparator."
} else {
if (adequate_power == TRUE) {
conclusion <- "The intervention was not non-inferior to the comparator."
} else {
conclusion <- "There was no evidence that the intervention was non-inferior to the comparator, however, this cannot be be ruled out."
}
}
} else {
left_margin <- rv$entry[[10]]
right_margin <- Inf
left_margin_label <- "Intervention is non-inferior to the left of this line"
right_margin_label <- NA
if (uci < left_margin) {
conclusion <- "The intervention was non-inferior to the comparator."
} else {
if (adequate_power == TRUE) {
conclusion <- "The intervention was not non-inferior to the comparator."
} else {
conclusion <- "There was no evidence that the intervention was non-inferior to the comparator, however, this cannot be be ruled out."
}
}
}
} else if (rv$entry[[7]] == "Intervention is equivalent to the comparator") {
left_margin <- -rv$entry[[10]]
right_margin <- rv$entry[[10]]
if (rv$entry[[9]] == "Higher values of the outcome (or more events) are better for the subject") {
left_margin_label <- "Intervention is worse to the left of this line"
right_margin_label <- "Intervention is better to the right of this line"
} else {
left_margin_label <- "Intervention is better to the left of this line"
right_margin_label <- "Intervention is worse to the right of this line"
}
if ((lci > left_margin) & (uci < right_margin)) {
conclusion <- "The intervention was equivalent to the comparator."
} else {
if (adequate_power == TRUE) {
if (rv$entry[[9]] == "Higher values of the outcome (or more events) are better for the subject") {
if (lci > right_margin) {
conclusion <- "The intervention was not equivalent to the comparator: the intervention was better than the comparator."
} else {
conclusion <- "The intervention was not equivalent to the comparator."
}
} else {
if (uci < left_margin) {
conclusion <- "The intervention was not equivalent to the comparator: the intervention was worse than the comparator."
} else {
conclusion <- "The intervention was not equivalent to the comparator."
}
}
} else {
conclusion <- "There was no evidence that the intervention was equivalent to the comparator, however, this cannot be be ruled out."
}
}
}
results_display <- data.frame(
`Analysis number` = paste0("AN",formatC((length(rv$plan) + 1), width = 4, format = "d", flag = 0)),
`Analysis type` = paste0(Predefined_lists$main_menu[Predefined_lists$menu_short == rv$first_menu_choice], ifelse(! is.na(rv$second_menu_choice), paste0(": ", rv$second_menu_choice), "")),
`Analysis outcome` = "Successful",
sample_size_calculations,
`Was power adequate based on difference prior to the start of the study` = adequate_power,
`Was power adequate based on observed difference` = adequate_power_observed,
Conclusion = conclusion,
check.names = FALSE
)
results <- rbind.data.frame(
colnames(results_display),
results_display
)
# Plots
decide_colour <- cbind.data.frame(
conclusion = c(
"The intervention was better than the comparator.", "The intervention was worse than the comparator.", "There was no important difference between the intervention and the comparator.", "There was no evidence of an important difference between the intervention and the comparator, but an important difference cannot be ruled out.",
"The intervention was not better than the comparator.", "There was no evidence that the intervention was better than the comparator, however, this cannot be be ruled out.",
"The intervention was non-inferior to the comparator.", "The intervention was not non-inferior to the comparator.", "There was no evidence that the intervention was non-inferior to the comparator, however, this cannot be be ruled out.",
"The intervention was equivalent to the comparator.", "The intervention was not equivalent to the comparator: the intervention was better than the comparator.", "The intervention was not equivalent to the comparator: the intervention was worse than the comparator.", "The intervention was not equivalent to the comparator.", "There was no evidence that the intervention was equivalent to the comparator, however, this cannot be be ruled out."
),
colour = c("darkgreen", "darkred", "darkblue", "yellow",
"darkred", "yellow",
"darkgreen", "darkred", "yellow",
"darkorange", "darkgreen", "darkred", "darkblue", "yellow"
)
)
data <- cbind.data.frame(
lci = lci,
uci = uci,
y = 1,
y_max = 1.1,
y_min = 0.9
)
vertical_lines <- c(0, left_margin, right_margin)
upper_limit <- max(abs(lci), abs(uci), if(! is.na(left_margin_label)) {abs(left_margin)}, if(! is.na(right_margin_label)){abs(right_margin)})*1.5
lower_limit <- -1 * upper_limit
xticks <- pretty(lower_limit:0, n = 6)
xticks <- c(xticks, -1*xticks)
xticks <- sort(unique(xticks), decreasing = FALSE)
data$peak <- (data$lci+data$uci)/2
diamond_colour <- decide_colour$colour[decide_colour$conclusion == conclusion]
plot_title <- "Conclusion (graphical depiction)"
if ((! is.na(left_margin_label)) & (! is.na(right_margin_label))) {
plot <-
ggplot() +
xlab("Difference between the intervention and the comparator") +
theme(axis.title.y = element_blank(),
axis.text.y = element_blank(),
axis.ticks.y = element_blank(),
legend.position = "none") +
scale_x_continuous(limits = c(lower_limit, upper_limit), breaks = xticks) +
scale_y_continuous(limits = c(0,3), n.breaks = 3) +
geom_text(data=data, aes(x = vertical_lines[1], y = (y + 1), label = "Nil difference", angle = 90)) +
geom_text(data=data, aes(x = vertical_lines[2], y = (y + 1), label = left_margin_label, angle = 90)) +
geom_text(data=data, aes(x = vertical_lines[3], y = (y + 1), label = right_margin_label, angle = 90)) +
geom_vline(xintercept = vertical_lines[1], color = "darkgrey") +
geom_vline(xintercept = vertical_lines[2], linetype= "dashed", color=ifelse((rv$entry[[9]] == "Higher values of the outcome (or more events) are better for the subject"), "darkred", "darkgreen")) +
geom_vline(xintercept = vertical_lines[3], linetype= "dashed", color=ifelse((rv$entry[[9]] == "Higher values of the outcome (or more events) are better for the subject"), "darkgreen", "darkred")) +
geom_polygon(
fill=diamond_colour,
col = "black",
aes(x = c(data$uci[1], data$peak[1],data$lci[1],data$peak[1]),
y = c(data$y[1],data$y_max[1],data$y[1],data$y_min[1])
)
)
} else if(! is.na(left_margin_label)){
plot <-
ggplot() +
xlab("Difference between the intervention and the comparator") +
theme(axis.title.y = element_blank(),
axis.text.y = element_blank(),
axis.ticks.y = element_blank(),
legend.position = "none") +
scale_x_continuous(limits = c(lower_limit, upper_limit), breaks = xticks) +
scale_y_continuous(limits = c(0,3), n.breaks = 3) +
geom_text(data=data, aes(x = vertical_lines[1], y = (y + 1), label = "Nil difference", angle = 90)) +
geom_text(data=data, aes(x = vertical_lines[2], y = (y + 1), label = left_margin_label, angle = 90)) +
geom_vline(xintercept = vertical_lines[1], color = "darkgrey") +
geom_vline(xintercept = vertical_lines[2], linetype= "dashed", color=ifelse((rv$entry[[9]] == "Higher values of the outcome (or more events) are better for the subject"), "darkred", "darkgreen")) +
geom_polygon(
fill=diamond_colour,
col = "black",
aes(x = c(data$uci[1], data$peak[1],data$lci[1],data$peak[1]),
y = c(data$y[1],data$y_max[1],data$y[1],data$y_min[1])
)
)
} else if(! is.na(right_margin_label)){
plot <-
ggplot() +
xlab("Difference between the intervention and the comparator") +
theme(axis.title.y = element_blank(),
axis.text.y = element_blank(),
axis.ticks.y = element_blank(),
legend.position = "none") +
scale_x_continuous(limits = c(lower_limit, upper_limit), breaks = xticks) +
scale_y_continuous(limits = c(0,3), n.breaks = 3) +
geom_text(data=data, aes(x = vertical_lines[1], y = (y + 1), label = "Nil difference", angle = 90)) +
geom_text(data=data, aes(x = vertical_lines[3], y = (y + 1), label = right_margin_label, angle = 90)) +
geom_vline(xintercept = vertical_lines[1], color = "darkgrey") +
geom_vline(xintercept = vertical_lines[3], linetype= "dashed", color=ifelse((rv$entry[[9]] == "Higher values of the outcome (or more events) are better for the subject"), "darkgreen", "darkred")) +
geom_polygon(
fill=diamond_colour,
col = "black",
aes(x = c(data$uci[1], data$peak[1],data$lci[1],data$peak[1]),
y = c(data$y[1],data$y_max[1],data$y[1],data$y_min[1])
)
)
}
suppressWarnings(suppressMessages(ggsave(filename = paste0(rv$StorageFolder,'/AN', formatC((length(rv$plan) + 1), width = 4, format = "d", flag = 0), '_', substr(str_replace_all(plot_title, "[^[:alnum:]]","_"), 1, 100) ,'.png'), plot = plot)))
plots_list <- paste0(rv$StorageFolder,'/AN', formatC((length(rv$plan) + 1), width = 4, format = "d", flag = 0), '_', substr(str_replace_all(plot_title, "[^[:alnum:]]","_"), 1, 100) ,'.png')
plots_list_display <- plots_list
display_table <- TRUE
display_plot <- TRUE
analysis_outcome <- "Successful"
function_output <- list(analysis_outcome = analysis_outcome, plan = plan, code = code, results = results, results_display = results_display, plots_list = plots_list, plots_list_display = plots_list_display, selections = selections, display_table = display_table, display_plot = display_plot)
return(function_output)
}
Try the EQUALSTATS package in your browser
Any scripts or data that you put into this service are public.
EQUALSTATS documentation built on Aug. 22, 2025, 5:10 p.m.
R Package Documentation
Browse R Packages
We want your feedback!
Note that we can't provide technical support on individual packages. You should contact the package authors for that.
Defines functions function.Make_Conclusions_Effect_size
Documented in function.Make_Conclusions_Effect_size
function.Make_Conclusions_Effect_size <- function(Predefined_lists, rv){
# Lists
plan <- {cbind.data.frame(
analysis_number = paste0("AN", formatC((length(rv$plan) + 1), width = 4, format = "d", flag = 0)),
first_menu_choice = rv$first_menu_choice,
second_menu_choice = rv$second_menu_choice,
entry_1 = paste0(rv$entry[[1]], collapse = "%_%"),
entry_2 = paste0(rv$entry[[2]], collapse = "%_%"),
entry_3 = paste0(rv$entry[[3]], collapse = "%_%"),
entry_4 = paste0(rv$entry[[4]], collapse = "%_%"),
entry_5 = paste0(rv$entry[[5]], collapse = "%_%"),
entry_6 = paste0(rv$entry[[6]], collapse = "%_%"),
entry_7 = paste0(rv$entry[[7]], collapse = "%_%"),
entry_8 = paste0(rv$entry[[8]], collapse = "%_%"),
entry_9 = paste0(rv$entry[[9]], collapse = "%_%"),
entry_10 = paste0(rv$entry[[10]], collapse = "%_%"),
entry_11 = paste0(rv$entry[[11]], collapse = "%_%"),
entry_12 = paste0(rv$entry[[12]], collapse = "%_%"),
entry_13 = paste0(rv$entry[[13]], collapse = "%_%"),
entry_14 = paste0(rv$entry[[14]], collapse = "%_%"),
entry_15 = paste0(rv$entry[[15]], collapse = "%_%"),
same_row_different_row = ""
)}
selections <- {paste0(
'<b>entry_1: </b>', paste0(rv$entry[[1]], collapse = "; "), '<br>',
'<b>entry_2: </b>', paste0(rv$entry[[2]], collapse = "; "), '<br>',
'<b>entry_3: </b>', paste0(rv$entry[[3]], collapse = "; "), '<br>',
'<b>entry_4: </b>', paste0(rv$entry[[4]], collapse = "; "), '<br>',
'<b>entry_5: </b>', paste0(rv$entry[[5]], collapse = "; "), '<br>',
'<b>entry_6: </b>', paste0(rv$entry[[6]], collapse = "; "), '<br>',
'<b>entry_7: </b>', paste0(rv$entry[[7]], collapse = "; "), '<br>',
'<b>entry_8: </b>', paste0(rv$entry[[8]], collapse = "; "), '<br>',
'<b>entry_9: </b>', paste0(rv$entry[[9]], collapse = "; "), '<br>',
'<b>entry_10: </b>', paste0(rv$entry[[10]], collapse = "; "), '<br>',
'<b>entry_11: </b>', paste0(rv$entry[[11]], collapse = "; "), '<br>',
'<b>entry_12: </b>', paste0(rv$entry[[12]], collapse = "; "), '<br>'
)}
code <- {paste0(
'# AN', formatC((length(rv$plan) + 1), width = 4, format = "d", flag = 0), '\n',
'rv$first_menu_choice <- "', rv$first_menu_choice, '"\n',
'rv$second_menu_choice <- ', ifelse(is.na(rv$second_menu_choice),NA,paste0('"',rv$second_menu_choice, '"')), '\n',
'rv$entry[[1]] <- ', rv$entry[[1]], '\n',
'rv$entry[[2]] <- ', rv$entry[[2]], '\n',
'rv$entry[[3]] <- ', rv$entry[[3]], '\n',
'rv$entry[[4]] <- ', rv$entry[[4]], '\n',
'rv$entry[[5]] <- ', rv$entry[[5]], '\n',
'rv$entry[[6]] <- ', rv$entry[[6]], '\n',
'rv$entry[[7]] <- "', rv$entry[[7]], '"\n',
'rv$entry[[8]] <- "', rv$entry[[8]], '"\n',
'rv$entry[[9]] <- "', rv$entry[[9]], '"\n',
'rv$entry[[10]] <- ', rv$entry[[10]], '\n',
'rv$entry[[11]] <- "', rv$entry[[11]], '"\n',
'rv$entry[[12]] <- "', rv$entry[[12]], '"\n',
'AN', formatC((length(rv$plan) + 1), width = 4, format = "d", flag = 0), '_results <- function.',rv$first_menu_choice,'(Predefined_lists, rv)', '\n',
if(length(rv$plan) == 0){
'if (TRUE %in% (AN0001_results$plots_list != "")) {invisible(file.rename(AN0001_results$plots_list, paste0(AN0001_results$plots_list,"_copy")))}
'
} else {
paste0(
'AN', formatC((length(rv$plan) + 1), width = 4, format = "d", flag = 0),'_results$results[2,1] <- "AN',formatC((length(rv$plan) + 1), width = 4, format = "d", flag = 0),'"', '\n',
'if (TRUE %in% (AN', formatC((length(rv$plan) + 1), width = 4, format = "d", flag = 0),'_results$plots_list != "")) {invisible(file.rename(AN', formatC((length(rv$plan) + 1), width = 4, format = "d", flag = 0),'_results$plots_list, str_replace_all(AN', formatC((length(rv$plan) + 1), width = 4, format = "d", flag = 0),'_results$plots_list, "/AN0001_", "/AN', formatC((length(rv$plan) + 1), width = 4, format = "d", flag = 0),'_")))}', '\n')
},
'write.table(x = AN', formatC((length(rv$plan) + 1), width = 4, format = "d", flag = 0),'_results$results, append = TRUE, file = paste0(rv$StorageFolder, "/results.csv"), sep = ",", row.names = FALSE, col.names = FALSE, na = "", quote = FALSE, qmethod = "double")', '\n'
)}
alpha_power <- data.frame(alpha = as.numeric(rv$entry[[11]]), power = as.numeric(rv$entry[[12]]))
if ((rv$entry[[7]] == "Intervention is better than comparator") | (rv$entry[[7]] == "Intervention is not worse than comparator")) {
alpha <- alpha_power$alpha*2
power <- alpha_power$power
} else if (rv$entry[[7]] == "Intervention is equivalent to the comparator") {
alpha <- alpha_power$alpha*2
power <- 1-((1-alpha_power$power)/2)
} else if (rv$entry[[7]] == "Intervention is better or worse than comparator") {
alpha <- alpha_power$alpha
power <- alpha_power$power
}
if (rv$entry[[8]] == "Dependent samples") {
type = "paired"
} else {
type = "two.sample"
}
if (rv$second_menu_choice == "Intervention study (continuous outcome)") {
desired_effect_size <- abs(rv$entry[[10]]/rv$entry[[2]])
observed_effect_size <- abs(rv$entry[[1]]/rv$entry[[2]])
if (desired_effect_size == 0) {desired_effect_size <- 0.01}
desired_mean_difference <- rv$entry[[10]]
sample_size_calculations <- suppressWarnings(try(cbind.data.frame(
`Desired mean difference` = desired_mean_difference,
`Observed mean difference` = abs(rv$entry[[1]]),
alpha_power,
`Sample size required (each group)` =
ceiling(pwr.t.test(n = NULL, d = desired_effect_size, sig.level = alpha, power = power, type = type)$n)
), silent = TRUE))
sample_size_calculations_observed <- suppressWarnings(try(lapply(1:nrow(alpha_power), function(z) {
ceiling(pwr.t.test(n = NULL, d = observed_effect_size, sig.level = alpha, power = power, type = type)$n)
}), silent = TRUE))
if (str_detect(sample_size_calculations[[1]][1], "Error")) {
sample_size_calculations <- cbind.data.frame(
`Desired mean difference` = desired_mean_difference,
`Observed mean difference` = abs(rv$entry[[1]]),
alpha_power,
`Sample size required (each group)` = "The standard deviation is too small compared to the desired difference"
)
adequate_power <- TRUE
} else {
sample_size_calculations$`Total sample size required` <- sample_size_calculations$`Sample size required (each group)`*2
adequate_power <- (sample_size_calculations$`Total sample size required` <= (rv$entry[[5]] + rv$entry[[6]]))
}
if (str_detect(sample_size_calculations_observed[[1]][1], "Error")) {
sample_size_calculations$`Total sample size required (based on observed difference)` <- "Unable to estimate the sample size based on observed difference. This is likely to be because of observed difference being too large or the standard deviation being too small."
adequate_power_observed <- TRUE
} else {
sample_size_calculations$`Total sample size required (based on observed difference)` <- sample_size_calculations_observed[[1]]*2
adequate_power_observed <- (sample_size_calculations$`Total sample size required (based on observed difference)` <= (rv$entry[[5]] + rv$entry[[6]]))
}
actual_difference <- rv$entry[[1]]
} else if (rv$second_menu_choice == "Intervention study (binary outcome)") {
proportion_in_intervention <- rv$entry[[2]] + ifelse(rv$entry[[9]] == "Higher values of the outcome (or more events) are better for the subject", rv$entry[[10]],- rv$entry[[10]])
if (proportion_in_intervention < 0) {proportion_in_intervention <- 0}
if (proportion_in_intervention > 1) {proportion_in_intervention <- 1}
desired_effect_size <- abs(ES.h(proportion_in_intervention, rv$entry[[2]]))
observed_effect_size <- abs(ES.h(rv$entry[[1]], rv$entry[[2]]))
if (desired_effect_size == 0) {desired_effect_size <- 0.01}
desired_difference_in_proportion <- rv$entry[[10]]
observed_difference_in_proportion <- abs(rv$entry[[1]] - rv$entry[[2]])
sample_size_calculations <- suppressWarnings(try(lapply(1:nrow(alpha_power), function(z) {
cbind.data.frame(
`Desired difference in proportion` = desired_difference_in_proportion,
`Observed difference in proportion` = observed_difference_in_proportion,
alpha_power[z,],
`Sample size required (each group)` =
if (rv$entry[[8]] == "Dependent samples") {
ceiling(pwr.t.test(n = NULL, d = desired_effect_size, sig.level = alpha[z], power = power[z], type = type)$n)
} else {
ceiling(pwr.2p.test(h=desired_effect_size, n = NULL, sig.level = alpha[z], power[z])$n)
}
)
}), silent = TRUE))
sample_size_calculations_observed <- suppressWarnings(try(lapply(1:nrow(alpha_power), function(z) {
if (rv$entry[[8]] == "Dependent samples") {
ceiling(pwr.t.test(n = NULL, d = observed_effect_size, sig.level = alpha[z], power = power[z], type = type)$n)
} else {
ceiling(pwr.2p.test(h=observed_effect_size, n = NULL, sig.level = alpha[z], power[z])$n)
}
}), silent = TRUE))
if (str_detect(sample_size_calculations[[1]][1], "Error")) {
sample_size_calculations <- cbind.data.frame(
`Desired difference in proportion` = desired_difference_in_proportion,
`Observed difference in proportion` = observed_difference_in_proportion,
alpha_power,
`Sample size required (each group)` = "The desired difference in proportion is too large"
)
adequate_power <- TRUE
} else {
sample_size_calculations <- do.call(rbind.data.frame, sample_size_calculations)
sample_size_calculations$`Total sample size required` <- sample_size_calculations$`Sample size required (each group)`*2
adequate_power <- (sample_size_calculations$`Total sample size required` <= (rv$entry[[5]] + rv$entry[[6]]))
}
if (str_detect(sample_size_calculations_observed[[1]][1], "Error")) {
sample_size_calculations$`Total sample size required (based on observed difference)` <- "Unable to estimate the sample size based on observed difference. This is likely to be because of observed difference being too large."
adequate_power_observed <- TRUE
} else {
sample_size_calculations$`Total sample size required (based on observed difference)` <- sample_size_calculations_observed[[1]]*2
adequate_power_observed <- (sample_size_calculations$`Total sample size required (based on observed difference)` <= (rv$entry[[5]] + rv$entry[[6]]))
}
actual_difference <- rv$entry[[1]] - rv$entry[[2]]
}
lci <- rv$entry[[3]]
uci <- rv$entry[[4]]
if (rv$entry[[7]] == "Intervention is better or worse than comparator") {
left_margin <- -(rv$entry[[10]])
right_margin <- rv$entry[[10]]
if (rv$entry[[9]] == "Higher values of the outcome (or more events) are better for the subject") {
left_margin_label <- "Intervention is worse to the left of this line"
right_margin_label <- "Intervention is better to the right of this line"
} else {
left_margin_label <- "Intervention is better to the left of this line"
right_margin_label <- "Intervention is worse to the right of this line"
}
if (((lci < left_margin) & (uci < left_margin)) | ((lci > right_margin) & (uci > right_margin))) {
if (rv$entry[[9]] == "Higher values of the outcome (or more events) are better for the subject") {
if (lci < left_margin) {
conclusion <- "The intervention was worse than the comparator."
} else {
conclusion <- "The intervention was better than the comparator."
}
} else {
if (lci < left_margin) {
conclusion <- "The intervention was better than the comparator."
} else {
conclusion <- "The intervention was worse than the comparator."
}
}
} else {
if (adequate_power == TRUE) {
conclusion <- "There was no important difference between the intervention and the comparator."
} else {
conclusion <- "There was no evidence of an important difference between the intervention and the comparator, but an important difference cannot be ruled out."
}
}
} else if (rv$entry[[7]] == "Intervention is better than comparator"){
if (rv$entry[[9]] == "Higher values of the outcome (or more events) are better for the subject") {
left_margin <- -Inf
right_margin <- rv$entry[[10]]
left_margin_label <- NA
right_margin_label <- "Intervention is better to the right of this line"
if (lci > right_margin) {
conclusion <- "The intervention was better than the comparator."
} else {
if (adequate_power == TRUE) {
conclusion <- "The intervention was not better than the comparator."
} else {
conclusion <- "There was no evidence that the intervention was better than the comparator, however, this cannot be be ruled out."
}
}
} else {
left_margin <- -(rv$entry[[10]])
right_margin <- Inf
left_margin_label <- "Intervention is better to the left of this line"
right_margin_label <- NA
if (uci < left_margin) {
conclusion <- "The intervention was better than the comparator."
} else {
if (adequate_power == TRUE) {
conclusion <- "The intervention was not better than the comparator."
} else {
conclusion <- "There was no evidence that the intervention was better than the comparator, however, this cannot be be ruled out."
}
}
}
} else if (rv$entry[[7]] == "Intervention is not worse than comparator") {
if (rv$entry[[9]] == "Higher values of the outcome (or more events) are better for the subject") {
left_margin <- -Inf
right_margin <- -(rv$entry[[10]])
left_margin_label <- NA
right_margin_label <- "Intervention is non-inferior to the right of this line"
if (lci > right_margin) {
conclusion <- "The intervention was non-inferior to the comparator."
} else {
if (adequate_power == TRUE) {
conclusion <- "The intervention was not non-inferior to the comparator."
} else {
conclusion <- "There was no evidence that the intervention was non-inferior to the comparator, however, this cannot be be ruled out."
}
}
} else {
left_margin <- rv$entry[[10]]
right_margin <- Inf
left_margin_label <- "Intervention is non-inferior to the left of this line"
right_margin_label <- NA
if (uci < left_margin) {
conclusion <- "The intervention was non-inferior to the comparator."
} else {
if (adequate_power == TRUE) {
conclusion <- "The intervention was not non-inferior to the comparator."
} else {
conclusion <- "There was no evidence that the intervention was non-inferior to the comparator, however, this cannot be be ruled out."
}
}
}
} else if (rv$entry[[7]] == "Intervention is equivalent to the comparator") {
left_margin <- -rv$entry[[10]]
right_margin <- rv$entry[[10]]
if (rv$entry[[9]] == "Higher values of the outcome (or more events) are better for the subject") {
left_margin_label <- "Intervention is worse to the left of this line"
right_margin_label <- "Intervention is better to the right of this line"
} else {
left_margin_label <- "Intervention is better to the left of this line"
right_margin_label <- "Intervention is worse to the right of this line"
}
if ((lci > left_margin) & (uci < right_margin)) {
conclusion <- "The intervention was equivalent to the comparator."
} else {
if (adequate_power == TRUE) {
if (rv$entry[[9]] == "Higher values of the outcome (or more events) are better for the subject") {
if (lci > right_margin) {
conclusion <- "The intervention was not equivalent to the comparator: the intervention was better than the comparator."
} else {
conclusion <- "The intervention was not equivalent to the comparator."
}
} else {
if (uci < left_margin) {
conclusion <- "The intervention was not equivalent to the comparator: the intervention was worse than the comparator."
} else {
conclusion <- "The intervention was not equivalent to the comparator."
}
}
} else {
conclusion <- "There was no evidence that the intervention was equivalent to the comparator, however, this cannot be be ruled out."
}
}
}
results_display <- data.frame(
`Analysis number` = paste0("AN",formatC((length(rv$plan) + 1), width = 4, format = "d", flag = 0)),
`Analysis type` = paste0(Predefined_lists$main_menu[Predefined_lists$menu_short == rv$first_menu_choice], ifelse(! is.na(rv$second_menu_choice), paste0(": ", rv$second_menu_choice), "")),
`Analysis outcome` = "Successful",
sample_size_calculations,
`Was power adequate based on difference prior to the start of the study` = adequate_power,
`Was power adequate based on observed difference` = adequate_power_observed,
Conclusion = conclusion,
check.names = FALSE
)
results <- rbind.data.frame(
colnames(results_display),
results_display
)
# Plots
decide_colour <- cbind.data.frame(
conclusion = c(
"The intervention was better than the comparator.", "The intervention was worse than the comparator.", "There was no important difference between the intervention and the comparator.", "There was no evidence of an important difference between the intervention and the comparator, but an important difference cannot be ruled out.",
"The intervention was not better than the comparator.", "There was no evidence that the intervention was better than the comparator, however, this cannot be be ruled out.",
"The intervention was non-inferior to the comparator.", "The intervention was not non-inferior to the comparator.", "There was no evidence that the intervention was non-inferior to the comparator, however, this cannot be be ruled out.",
"The intervention was equivalent to the comparator.", "The intervention was not equivalent to the comparator: the intervention was better than the comparator.", "The intervention was not equivalent to the comparator: the intervention was worse than the comparator.", "The intervention was not equivalent to the comparator.", "There was no evidence that the intervention was equivalent to the comparator, however, this cannot be be ruled out."
),
colour = c("darkgreen", "darkred", "darkblue", "yellow",
"darkred", "yellow",
"darkgreen", "darkred", "yellow",
"darkorange", "darkgreen", "darkred", "darkblue", "yellow"
)
)
data <- cbind.data.frame(
lci = lci,
uci = uci,
y = 1,
y_max = 1.1,
y_min = 0.9
)
vertical_lines <- c(0, left_margin, right_margin)
upper_limit <- max(abs(lci), abs(uci), if(! is.na(left_margin_label)) {abs(left_margin)}, if(! is.na(right_margin_label)){abs(right_margin)})*1.5
lower_limit <- -1 * upper_limit
xticks <- pretty(lower_limit:0, n = 6)
xticks <- c(xticks, -1*xticks)
xticks <- sort(unique(xticks), decreasing = FALSE)
data$peak <- (data$lci+data$uci)/2
diamond_colour <- decide_colour$colour[decide_colour$conclusion == conclusion]
plot_title <- "Conclusion (graphical depiction)"
if ((! is.na(left_margin_label)) & (! is.na(right_margin_label))) {
plot <-
ggplot() +
xlab("Difference between the intervention and the comparator") +
theme(axis.title.y = element_blank(),
axis.text.y = element_blank(),
axis.ticks.y = element_blank(),
legend.position = "none") +
scale_x_continuous(limits = c(lower_limit, upper_limit), breaks = xticks) +
scale_y_continuous(limits = c(0,3), n.breaks = 3) +
geom_text(data=data, aes(x = vertical_lines[1], y = (y + 1), label = "Nil difference", angle = 90)) +
geom_text(data=data, aes(x = vertical_lines[2], y = (y + 1), label = left_margin_label, angle = 90)) +
geom_text(data=data, aes(x = vertical_lines[3], y = (y + 1), label = right_margin_label, angle = 90)) +
geom_vline(xintercept = vertical_lines[1], color = "darkgrey") +
geom_vline(xintercept = vertical_lines[2], linetype= "dashed", color=ifelse((rv$entry[[9]] == "Higher values of the outcome (or more events) are better for the subject"), "darkred", "darkgreen")) +
geom_vline(xintercept = vertical_lines[3], linetype= "dashed", color=ifelse((rv$entry[[9]] == "Higher values of the outcome (or more events) are better for the subject"), "darkgreen", "darkred")) +
geom_polygon(
fill=diamond_colour,
col = "black",
aes(x = c(data$uci[1], data$peak[1],data$lci[1],data$peak[1]),
y = c(data$y[1],data$y_max[1],data$y[1],data$y_min[1])
)
)
} else if(! is.na(left_margin_label)){
plot <-
ggplot() +
xlab("Difference between the intervention and the comparator") +
theme(axis.title.y = element_blank(),
axis.text.y = element_blank(),
axis.ticks.y = element_blank(),
legend.position = "none") +
scale_x_continuous(limits = c(lower_limit, upper_limit), breaks = xticks) +
scale_y_continuous(limits = c(0,3), n.breaks = 3) +
geom_text(data=data, aes(x = vertical_lines[1], y = (y + 1), label = "Nil difference", angle = 90)) +
geom_text(data=data, aes(x = vertical_lines[2], y = (y + 1), label = left_margin_label, angle = 90)) +
geom_vline(xintercept = vertical_lines[1], color = "darkgrey") +
geom_vline(xintercept = vertical_lines[2], linetype= "dashed", color=ifelse((rv$entry[[9]] == "Higher values of the outcome (or more events) are better for the subject"), "darkred", "darkgreen")) +
geom_polygon(
fill=diamond_colour,
col = "black",
aes(x = c(data$uci[1], data$peak[1],data$lci[1],data$peak[1]),
y = c(data$y[1],data$y_max[1],data$y[1],data$y_min[1])
)
)
} else if(! is.na(right_margin_label)){
plot <-
ggplot() +
xlab("Difference between the intervention and the comparator") +
theme(axis.title.y = element_blank(),
axis.text.y = element_blank(),
axis.ticks.y = element_blank(),
legend.position = "none") +
scale_x_continuous(limits = c(lower_limit, upper_limit), breaks = xticks) +
scale_y_continuous(limits = c(0,3), n.breaks = 3) +
geom_text(data=data, aes(x = vertical_lines[1], y = (y + 1), label = "Nil difference", angle = 90)) +
geom_text(data=data, aes(x = vertical_lines[3], y = (y + 1), label = right_margin_label, angle = 90)) +
geom_vline(xintercept = vertical_lines[1], color = "darkgrey") +
geom_vline(xintercept = vertical_lines[3], linetype= "dashed", color=ifelse((rv$entry[[9]] == "Higher values of the outcome (or more events) are better for the subject"), "darkgreen", "darkred")) +
geom_polygon(
fill=diamond_colour,
col = "black",
aes(x = c(data$uci[1], data$peak[1],data$lci[1],data$peak[1]),
y = c(data$y[1],data$y_max[1],data$y[1],data$y_min[1])
)
)
}
suppressWarnings(suppressMessages(ggsave(filename = paste0(rv$StorageFolder,'/AN', formatC((length(rv$plan) + 1), width = 4, format = "d", flag = 0), '_', substr(str_replace_all(plot_title, "[^[:alnum:]]","_"), 1, 100) ,'.png'), plot = plot)))
plots_list <- paste0(rv$StorageFolder,'/AN', formatC((length(rv$plan) + 1), width = 4, format = "d", flag = 0), '_', substr(str_replace_all(plot_title, "[^[:alnum:]]","_"), 1, 100) ,'.png')
plots_list_display <- plots_list
display_table <- TRUE
display_plot <- TRUE
analysis_outcome <- "Successful"
function_output <- list(analysis_outcome = analysis_outcome, plan = plan, code = code, results = results, results_display = results_display, plots_list = plots_list, plots_list_display = plots_list_display, selections = selections, display_table = display_table, display_plot = display_plot)
return(function_output)
}
Try the EQUALSTATS package in your browser
Any scripts or data that you put into this service are public.
R Package Documentation
Browse R Packages
We want your feedback!
Note that we can't provide technical support on individual packages. You should contact the package authors for that.
Embedding an R snippet on your website
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.