#' tib2tab
#'
#' This function accepts a master tibble made in dat2tib and creates a summary table with one row per outcome variable
#' and summary statistics by treatment arms.
#'
#' @param mtib A master tibble
#' @param stat_fmt Format for summary statistics by arm in glue syntax
#' @param comp_fmt Format for pairwise comparison statistics in glue syntax
#' @param adjust a logical value indicating whether summary statistics should be adjusted or unadjusted by model covariates
#'
#' @return
#'
#'
#' @import dplyr
#' @importFrom stringr str_glue
#' @importFrom purrr map
#' @importFrom pixiedust pval_string
#'
#'
#' @examples
#' \dontrun{
#' tib <- dat2tib(data = cdisc_data,
#' model = lm(aval ~ arm + age + sex),
#' outcome = aval,
#' trt = arm,
#' nest = param,
#' tran='none')
#'
#' tib2tab(mtib = tib,
#' stat_fmt = "{mean} ({sd})",
#' comp_fmt = "{estimate} ({lower_CL}, {upper_CL})")
#' }
#'
#' @export
#'
#'
#this version is user specified format
# tib2tab <- function(mtib, stat_fmt, comp_fmt, adjust = F){
#
# stat_vars <- stat_fmt %>%
# str_match_all("[{](.*?)[:]") %>% .[[1]] %>% .[,2]
# stat_vars_sym <- stat_vars %>% syms
#
# comp_vars <- comp_fmt %>%
# str_match_all("[{](.*?)[:]") %>% .[[1]] %>% .[,2]
#
# if(adjust == F){
# mtab <- mtib %>%
# mutate(summ = map(summ, ~.x %>%
# as_data_frame %>%
# filter(stat %in% stat_vars_sym) %>%
# select(arm, stat, value) %>%
# spread(stat, value) %>%
# mutate(means = glue_fmt(stat_fmt)) %>%
# select(-c(!!! stat_vars_sym)) %>%
# spread(arm, means))) %>%
# mutate(p = map(comp, ~ .x %>%
# unite(diff_name, level1, level2, sep = "v. ") %>%
# mutate(diff_name = str_glue("{diff_name} p-value"),
# pval = str_glue("{format_pval(p.value, 3, equal = FALSE)}")) %>%
# select(diff_name, pval) %>%
# spread(diff_name, pval)),
# comp = map(comp, ~ .x %>%
# unite(diff_name, level1, level2, sep=" vs. ") %>%
# select(diff_name, comp_vars) %>%
# mutate(diff = glue_fmt(comp_fmt)) %>%
# select(diff_name, diff) %>%
# spread(diff_name, diff) ))%>%
# select(-c(data, mod, ref, emm)) %>%
# unnest
# } else if (adjust == T){
# mtab <- mtib %>%
# mutate(emm = map(emm, ~.x %>%
# select(arm, stat_vars) %>%
# mutate(means = glue_fmt(stat_fmt)) %>%
# select(-c(!!! stat_vars_sym)) %>%
# spread(arm, means)),
# p = map(comp, ~ .x %>%
# unite(diff_name, level1, level2, sep = "v. ") %>%
# mutate(diff_name = str_glue("{diff_name} p-value"),
# pval = str_glue("{format_pval(p.value, 3, equal = FALSE)}")) %>%
# select(diff_name, pval) %>%
# spread(diff_name, pval)),
# comp = map(comp, ~ .x %>%
# unite(diff_name, level1, level2, sep=" vs. ") %>%
# select(diff_name, comp_vars) %>%
# mutate(diff = glue_fmt(comp_fmt)) %>%
# select(diff_name, diff) %>%
# spread(diff_name, diff) )) %>%
# select(-c(data, mod, ref, summ)) %>%
# unnest
# }
#
# return(mtab)
#
# }
#this version is using our autoformat function
nest <- nest_legacy
unnest <- unnest_legacy
tib2tab <- function(mtib, stat_fmt, comp_fmt, adjust = F){
stat_vars <- stat_fmt %>%
str_match_all("[{](.*?)[}]") %>% .[[1]] %>% .[,2]
stat_vars_sym <- stat_vars %>% syms
comp_vars <- comp_fmt %>%
str_match_all("[{](.*?)[}]") %>% .[[1]] %>% .[,2]
if(adjust == F){
mtab <- mtib %>%
mutate(summ = map(summ, ~.x %>%
mutate_at(vars(-1), funs(format_value_auto(.))) %>%
mutate(means = str_glue(stat_fmt)) %>%
select(trt, means) %>%
spread(trt, means))) %>%
mutate(p = map(comp, ~ .x %>%
mutate_at(vars(-c(1, p_value)), funs(format_value_auto(.))) %>%
mutate(contrast = str_glue("{contrast} p-value"),
# pval = str_glue("{pixiedust::pval_string(p_value)}")) %>%
pval = p_value) %>%
select(contrast, pval) %>%
spread(contrast, pval)),
comp = map(comp, ~ .x %>%
mutate_at(vars(-c(1, p_value)), funs(format_value_auto(.))) %>%
select(contrast, comp_vars) %>%
mutate(diff = str_glue(comp_fmt)) %>%
select(contrast, diff) %>%
spread(contrast, diff) ))%>%
select(-c(data, mod, ref, emm, emm_summ, fit_metrics, joint)) %>%
unnest
} else if (adjust == T){
mtab <- mtib %>%
mutate(emm_summ = map(emm_summ, ~.x %>%
mutate_at(vars(-1), funs(format_value_auto(.))) %>%
select(trt, stat_vars) %>%
mutate(means = str_glue(stat_fmt)) %>%
select(trt, means) %>%
spread(trt, means)),
p = map(comp, ~ .x %>%
mutate_at(vars(-c(1, p_value)), funs(format_value_auto(.))) %>%
mutate(contrast = str_glue("{contrast} p-value"),
# pval = str_glue("{pixiedust::pval_string(p_value)}")) %>%
pval = p_value) %>%
select(contrast, pval) %>%
spread(contrast, pval)),
comp = map(comp, ~ .x %>%
mutate_at(vars(-c(1, p_value)), funs(format_value_auto(.))) %>%
select(contrast, comp_vars) %>%
mutate(diff = str_glue(comp_fmt)) %>%
select(contrast, diff) %>%
spread(contrast, diff) )) %>%
select(-c(data, mod, ref, summ, emm, fit_metrics, joint)) %>%
unnest
}
ngroups <- dim(mtib$summ[[1]])[1]
stat_txt <- gsub("\\{|\\}", "", stat_fmt)
comp_txt <- gsub("\\{|\\}", "", comp_fmt)
attributes(mtab)$stat <- stat_txt
attributes(mtab)$comp <- comp_txt
attributes(mtab)$ngroup <- ngroups
return(mtab)
}
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.