setup
#' Display Parameters Table
#'
#' This function generates a markdown table displaying the names and values of parameters
#' from a named list.
#'
#' @param named_list A named list where each name represents a parameter name and the list
#' element represents the parameter value. Date values in the list are automatically
#' converted to character strings for display purposes.
#'
#' @return Prints a markdown table with two columns: "Parameter Name" and "Parameter Values".
#' The function does not return a value but displays the table directly to the output.
#'
#' @importFrom knitr kable
#' @examples
#' params <- list("Start Date" = as.Date("2020-01-01"),
#' "End Date" = as.Date("2020-12-31"),
#' "Threshold" = 10)
#' display_params_table(params)
#'
#' @export
display_params_table <- function(named_list) {
display_table <- data.frame()
value_names <- data.frame()
for (i in 1:length(named_list)) {
# dates will display as numeric by default, so convert to char first
if (class(named_list[[i]]) == "Date") {
named_list[[i]] = as.character(named_list[[i]])
}
if (!is.null(names(named_list[[i]]))) {
value_names <- rbind(value_names, paste(names(named_list[[i]]), collapse = ', '))
}
values <- data.frame(I(list(named_list[[i]])))
display_table <- rbind(display_table, values)
}
round_numeric <- function(x, digits = 3) {
if (is.numeric(x)) {
return(round(x, digits))
} else {
return(x)
}
}
display_table[1] <- lapply(display_table[1], function(sublist) {
lapply(sublist, round_numeric)
})
class(display_table[[1]]) <- "list"
if (nrow(value_names) == 0) {
knitr::kable(
cbind(names(named_list), display_table),
col.names = c("Name", "Value")
)
} else {
knitr::kable(
cbind(names(named_list), value_names, display_table),
col.names = c("Name", "Value Labels", "Value")
)
}
}
# function to solve power results for tables (different max eff) BayesianMCPMod
# return(successrates models, average)
extract_success_rates <- function(results_list, models) {
success_rates <- list()
for (i in seq_along(results_list)) {
success_rate <- c()
for (model in models) {
success_rate <- c(success_rate, attr(results_list[[i]][[model]]$BayesianMCP,"successRate"))
}
success_rates[[paste0("Bay_", attr(results_list[[i]],"maxEff"))]] <- c(success_rate, attr(results_list[[i]], "avgSuccessRate"))
}
return(success_rates)
}
# function to solve power results for tables (different nsample) BayesianMCPMod
#models <c-(min_scenario)
extract_success_rates_nsample <- function(results_list, models) {
success_rates <- list()
for (i in seq_along(results_list)) {
success_rate <- c()
for (model in models) {
success_rate <- c(success_rate, attr(results_list[[i]][[model]]$BayesianMCP,"successRate"))
}
success_rates[[paste0("Bay_", i )]] <- c(success_rate, attr(results_list[[i]],"avgSuccessRate"))
}
return(success_rates)
}
#input: result_list, models =
extract_success_rates_nsim <- function(results_list, models, n_sim) {
success_rates <- list()
for (model in models) {
success_rate <- c()
for (i in seq_along(n_sim)) {
success_rate <- c(success_rate, attr(results_list[[i]][[model]]$BayesianMCP,"successRate"))
}
success_rates[[paste0("Bay_", model)]] <- c(success_rate)
}
return(success_rates)
}
print_result_Bay_max_eff <- function(results, scenario, variable) {
result_table <- t(data.table(
Bay_0.00 = results$`Bay_1e-04`,
Bay_0.05 = results$Bay_0.05,
Bay_0.1 = results$Bay_0.1,
Bay_0.2 = results$Bay_0.2,
Bay_0.3 = results$Bay_0.3,
Bay_0.5 = results$Bay_0.5))
result_table <- as.data.table(result_table)
names(result_table) <- scenario
#return(result_table)
kable_result <- kable(cbind(variable, result_table))%>%
kable_classic(full_width = TRUE)%>%
add_header_above(c("Power results different expected effects " = length(scenario)+1), font_size = 15, bold = TRUE)%>%
add_header_above(c("BayesianMCPMod " = length(scenario)+1), font_size = 15, bold = TRUE)
list(result_table = result_table, kable_result = kable_result)
}
print_result_Bay_nsample <- function(results, scenario, variable) {
result_table <- t(data.table(
Bay_1 = results$Bay_1,
Bay_2 = results$Bay_2,
Bay_3 = results$Bay_3,
Bay_4 = results$Bay_4))
result_table <- as.data.table(result_table)
names(result_table) <- scenario
#return(result_table)
kable_result <- kable(cbind(variable, result_table))%>%
kable_classic(full_width = TRUE)%>%
add_header_above(c("Success probability results different sample sizes " = length(scenario)+1), font_size = 15, bold = TRUE)%>%
add_header_above(c("BayesianMCPMod " = length(scenario)+1), font_size = 15, bold = TRUE)
list(result_table = result_table, kable_result = kable_result)
}
plot_power_deviation <- function(data, x, xlab){
plot <- ggplot2::ggplot(data, aes(x = x, y = value, color = variable, group = variable))+
geom_point()+
geom_line() +
scale_x_continuous(breaks = c(0, 100, 500, 1000, 2500, 5000, 10000),
labels = c("", "100", "", "1000", "2500", "5000", "10000")) +
geom_hline(aes(yintercept = 0), linetype = 2)+
geom_hline(aes(yintercept = -0.05), linetype = 2, color = "darkgrey")+
geom_hline(aes(yintercept = 0.05), linetype = 2, color = "darkgrey")+
geom_hline(aes(yintercept = -0.1), linetype = 2, color = "darkgrey")+
geom_hline(aes(yintercept = 0.1), linetype = 2, color = "darkgrey")+
scale_color_manual(name = "assumed true model", values = c("linear" = "red", "exponential" = "blue", "emax" = "darkgreen", "logistic" = "orange", "sigemax" = "purple", "beta" = "deepskyblue", "quadratic" = "deeppink"))+
labs(x = xlab, y = "power deviation")+
ylim(-0.15, 0.15)+
theme_classic()
return(plot)
}
# parallel----------------------------------------------
chunkVector <- function (x, n_chunks) {
if (n_chunks <= 1) {
chunk_list <- list(x)
} else {
chunk_list <- unname(split(x, cut(seq_along(x), n_chunks, labels = FALSE)))
}
return(chunk_list)
}
library(BayesianMCPMod)
library(RBesT)
library(clinDR)
library(dplyr)
library(tibble)
library(reactable)
library(DoseFinding)
library(MCPModPack)
library(kableExtra)
library(data.table)
library(doFuture)
library(doRNG)
registerDoFuture()
plan(multisession)
set.seed(7015)
