diff --git a/NAMESPACE b/NAMESPACE new file mode 100644 index 0000000..a11fd31 --- /dev/null +++ b/NAMESPACE @@ -0,0 +1,99 @@ +# Generated by roxygen2: do not edit by hand + +S3method(flextable::as_flextable,ae_table_soc) +export("%>%") +export(ae_plot_grade) +export(ae_plot_grade_max) +export(ae_plot_grade_n) +export(ae_plot_grade_sum) +export(ae_plot_soc) +export(ae_table_grade) +export(ae_table_grade_max) +export(ae_table_grade_n) +export(ae_table_soc) +export(butterfly_plot) +importFrom(cli,cli_abort) +importFrom(cli,cli_warn) +importFrom(dplyr,across) +importFrom(dplyr,any_of) +importFrom(dplyr,arrange) +importFrom(dplyr,case_match) +importFrom(dplyr,case_when) +importFrom(dplyr,count) +importFrom(dplyr,cur_column) +importFrom(dplyr,cur_group) +importFrom(dplyr,distinct) +importFrom(dplyr,filter) +importFrom(dplyr,full_join) +importFrom(dplyr,if_else) +importFrom(dplyr,lag) +importFrom(dplyr,lead) +importFrom(dplyr,left_join) +importFrom(dplyr,mutate) +importFrom(dplyr,n) +importFrom(dplyr,na_if) +importFrom(dplyr,pull) +importFrom(dplyr,recode) +importFrom(dplyr,rename) +importFrom(dplyr,rename_with) +importFrom(dplyr,select) +importFrom(dplyr,setdiff) +importFrom(dplyr,summarise) +importFrom(dplyr,transmute) +importFrom(forcats,as_factor) +importFrom(forcats,fct_infreq) +importFrom(forcats,fct_relevel) +importFrom(forcats,fct_reorder) +importFrom(ggplot2,aes) +importFrom(ggplot2,element_blank) +importFrom(ggplot2,element_text) +importFrom(ggplot2,facet_grid) +importFrom(ggplot2,facet_wrap) +importFrom(ggplot2,geom_bar) +importFrom(ggplot2,geom_blank) +importFrom(ggplot2,geom_col) +importFrom(ggplot2,ggplot) +importFrom(ggplot2,labs) +importFrom(ggplot2,position_dodge) +importFrom(ggplot2,position_fill) +importFrom(ggplot2,position_stack) +importFrom(ggplot2,scale_fill_steps) +importFrom(ggplot2,scale_x_continuous) +importFrom(ggplot2,scale_y_continuous) +importFrom(ggplot2,scale_y_discrete) +importFrom(ggplot2,theme) +importFrom(ggplot2,unit) +importFrom(ggplot2,vars) +importFrom(ggplot2,waiver) +importFrom(glue,glue) +importFrom(lifecycle,deprecate_warn) +importFrom(magrittr,"%>%") +importFrom(purrr,iwalk) +importFrom(purrr,keep) +importFrom(purrr,map) +importFrom(purrr,map_int) +importFrom(purrr,map_lgl) +importFrom(rlang,arg_match) +importFrom(rlang,check_dots_empty) +importFrom(rlang,check_installed) +importFrom(rlang,ensym) +importFrom(rlang,int) +importFrom(rlang,is_empty) +importFrom(rlang,set_names) +importFrom(scales,label_percent) +importFrom(stats,na.omit) +importFrom(stringr,str_detect) +importFrom(stringr,str_remove) +importFrom(stringr,str_replace_all) +importFrom(stringr,str_starts) +importFrom(tibble,as_tibble_col) +importFrom(tibble,as_tibble_row) +importFrom(tibble,deframe) +importFrom(tibble,lst) +importFrom(tidyr,build_wider_spec) +importFrom(tidyr,pivot_longer) +importFrom(tidyr,pivot_wider_spec) +importFrom(tidyr,replace_na) +importFrom(tidyr,separate_wider_regex) +importFrom(tidyr,unnest) +importFrom(tidyselect,matches) diff --git a/NEWS.md b/NEWS.md index 21b2e3f..aaaf5da 100644 --- a/NEWS.md +++ b/NEWS.md @@ -5,5 +5,5 @@ Clinical Research tools. See documentation at % +#' as_flextable(header_show_n=TRUE) +#' +#' ae_table_grade(df_ae=ae, df_enrol=enrolres, arm="ARM") %>% +#' as_flextable(header_show_n=TRUE) +#' +#' #To get SAE only, filter df_ae first +#' library(dplyr) +#' ae %>% +#' filter(sae=="Yes") %>% +#' ae_table_grade(df_enrol=enrolres, arm="ARM") %>% +#' dplyr::mutate_all(~stringr::str_replace(.x, "AE", "SAE")) %>% +#' as_flextable(header_show_n=TRUE) +#' +#' } +ae_table_grade = function( + df_ae, ..., df_enrol, + variant=c("max", "sup", "eq"), + arm=NULL, grade="AEGR", subjid="SUBJID", + percent=TRUE, + total=TRUE +){ + check_installed("crosstable", "for `ae_table_grade()` to work.") + check_dots_empty() + + assert_names_exists(df_ae, lst(subjid, grade)) + assert_names_exists(df_enrol, lst(subjid, arm)) + + if(missing(total) && is.null(arm)) total = FALSE + if(total) total = "row" + default_arm = set_label("All patients", "Treatment arm") + + df_ae = df_ae %>% rename_with(tolower) %>% + select(subjid=tolower(subjid), grade=tolower(grade)) + df_enrol = df_enrol %>% rename_with(tolower) %>% + select(subjid=tolower(subjid), arm=tolower(arm)) %>% + mutate(arm=if(is.null(.env$arm)) default_arm else .data$arm) + + df = df_enrol %>% + full_join(df_ae, by=tolower(subjid)) %>% + arrange(subjid) %>% + mutate( + grade = fix_grade(grade), + ) + + variant = case_match(variant, "max"~"max_grade", "sup"~"any_grade_sup", + "eq"~"any_grade_eq") + rex = variant %>% paste(collapse="|") %>% paste0("^(", ., ")") + + percent_pattern = if(isTRUE(percent)) "{n} ({scales::percent(n/n_col_na,1)})" + else if(percent=="only") "{n/n_col}" else "{n}" + percent_pattern = list(body=percent_pattern, total_col=percent_pattern) + + lab_no_ae = "No declared AE" + + rtn = df %>% + summarise( + max_grade_na = case_when(!cur_group()$subjid %in% df_ae$subjid ~ lab_no_ae, + all(is.na(grade), na.rm=TRUE) ~ "Grade all missing", + .default="foobar"), + max_grade_1 = ifelse(max_narm(grade) == 1 , "Grade 1", "foobar"), + max_grade_2 = ifelse(max_narm(grade) == 2 , "Grade 2", "foobar"), + max_grade_3 = ifelse(max_narm(grade) == 3 , "Grade 3", "foobar"), + max_grade_4 = ifelse(max_narm(grade) == 4 , "Grade 4", "foobar"), + max_grade_5 = ifelse(max_narm(grade) == 5 , "Grade 5", "foobar"), + any_grade_sup_na = case_when(!cur_group()$subjid %in% df_ae$subjid ~ lab_no_ae, + any(is.na(grade), na.rm=TRUE) ~ "Any missing grade", + .default="foobar"),, + any_grade_sup_1 = ifelse(any(grade >= 1, na.rm=TRUE), "Grade \u2265 1", "foobar"), + any_grade_sup_2 = ifelse(any(grade >= 2, na.rm=TRUE), "Grade \u2265 2", "foobar"), + any_grade_sup_3 = ifelse(any(grade >= 3, na.rm=TRUE), "Grade \u2265 3", "foobar"), + any_grade_sup_4 = ifelse(any(grade >= 4, na.rm=TRUE), "Grade \u2265 4", "foobar"), + any_grade_sup_5 = ifelse(any(grade >= 5, na.rm=TRUE), "Grade = 5", "foobar"), + any_grade_eq_na = any_grade_sup_na, + any_grade_eq_1 = ifelse(any(grade == 1, na.rm=TRUE), "Grade 1", "foobar"), + any_grade_eq_2 = ifelse(any(grade == 2, na.rm=TRUE), "Grade 2", "foobar"), + any_grade_eq_3 = ifelse(any(grade == 3, na.rm=TRUE), "Grade 3", "foobar"), + any_grade_eq_4 = ifelse(any(grade == 4, na.rm=TRUE), "Grade 4", "foobar"), + any_grade_eq_5 = ifelse(any(grade == 5, na.rm=TRUE), "Grade 5", "foobar"), + .by=c(subjid, arm) + ) %>% + crosstable::crosstable(matches(rex), + by=arm, total=total, + percent_pattern=percent_pattern) %>% + filter(variable!="foobar" & variable!="NA") %>% + mutate( + label=case_when(str_starts(.id, "max_grade_") ~ "Patient maximum AE grade", + str_starts(.id, "any_grade_sup_") ~ "Patient had at least one AE of grade", + str_starts(.id, "any_grade_eq_") ~ "Patient had at least one AE of grade ", + .default="ERROR"), + .id = str_remove(.id, "_[^_]*$") %>% factor(levels=variant), + label = fct_reorder(label, as.numeric(.id)), + variable = suppressWarnings(fct_relevel(variable, "Grade = 5", after=4)), + variable = suppressWarnings(fct_relevel(variable, lab_no_ae, after=0)), + variable = suppressWarnings(fct_relevel(variable, ~str_subset(.x, "missing"), after=Inf)), + ) %>% + arrange(.id, label, variable) + + rtn +} + + +# Plots --------------------------------------------------------------------------------------- + + + +#' Graphic representation of AEs +#' +#' Produce a graphic representation of AE, counting AE as bars for each patient, colored by grade. Can be faceted by treatment arm. +#' +#' @inheritParams ae_table_grade +#' @param type whether to present patients as proportions (`relative`) or as counts (`absolute`) +#' @param position Position adjustment (cf. [ggplot2::geom_col()]) +#' +#' @return a ggplot +#' @export +#' +#' @examples +#' tm = edc_example_ae() +#' load_list(tm) +#' ae_plot_grade(df_ae=ae, df_enrol=enrolres) +#' ae_plot_grade(df_ae=ae, df_enrol=enrolres, arm="ARM", variant=c("sup", "max")) +#' ae_plot_grade(df_ae=ae, df_enrol=enrolres, arm="ARM", type="absolute") +#' ae_plot_grade(df_ae=ae, df_enrol=enrolres, arm="ARM", position="fill") +#' ae_plot_grade(df_ae=ae, df_enrol=enrolres, arm="ARM", position="stack", type="absolute") +#' @importFrom cli cli_warn +#' @importFrom dplyr across cur_group mutate n +#' @importFrom forcats as_factor +#' @importFrom ggplot2 aes element_text facet_wrap geom_col ggplot labs position_dodge position_fill position_stack scale_y_continuous theme +#' @importFrom scales label_percent +#' @importFrom tidyr pivot_longer +ae_plot_grade = function( + df_ae, ..., df_enrol, + variant = c("max", "sup", "eq"), + position = c("dodge", "stack", "fill"), + type = c("relative", "absolute"), + arm=NULL, grade="AEGR", subjid="SUBJID", total=FALSE +){ + type = match.arg(type) + position = match.arg(position) + + if(type=="relative" && position=="stack"){ + type = "absolute" + cli_warn('{.arg type} has been corrected to {.val absolute} to + be consistent with `position="stack"`.') + } + if(type=="relative" || position=="fill"){ + percent = "only" + y_lab = "Patient proportion" + add_layer = scale_y_continuous(labels=label_percent(), limits=0:1) + } else { + percent = FALSE + y_lab = "Patient count" + add_layer = NULL + } + + fill_aes = NULL + if(!is.null(arm)){ + df_enrol = df_enrol %>% + # mutate(arm = if(is.null(.env$arm)) "All Patients" else .data$arm) %>% + mutate(arm2 = paste0(cur_group()[[1]], " (N=", n(), ")"), + .by=any_of2(arm)) + arm="arm2" + fill_aes = aes(fill=name) + } + + + tbl = ae_table_grade(df_ae=df_ae, df_enrol=df_enrol, variant=variant, + arm=arm, grade=grade, subjid=subjid, + percent=percent, total=total) + p = switch(position, fill=position_fill(), stack=position_stack(), + dodge=position_dodge(0.9)) + + tbl %>% + mutate(across(-c(.id, label, variable), ~as.numeric(as.character(.x)))) %>% + pivot_longer(-c(.id, label, variable)) %>% + mutate(name=as_factor(name)) %>% + ggplot(aes(x=variable, y=value)) + fill_aes + + geom_col(position=p) + + labs(x=NULL, fill=NULL, y=y_lab) + + facet_wrap(~label, scales="free_x") + + add_layer + + theme(axis.text.x = element_text(angle = 45, hjust = 1, vjust = 1), + legend.position="top") +} + + + + +#' Graphic representation of AEs +#' +#' Produce a graphic representation of AE, counting AE as bars for each patient, colored by grade. Can be faceted by treatment arm. +#' +#' @param weights (optional) a length 5 numeric vector, giving the weights of each grade +#' @param low the color of Grade 1 AE +#' @param high the color of Grade 5 AE +#' @inheritParams ae_table_soc +#' @inherit ae_table_soc seealso +#' +#' @return a ggplot +#' @export +#' @importFrom dplyr across any_of arrange count full_join mutate rename_with select +#' @importFrom forcats fct_infreq +#' @importFrom ggplot2 aes element_blank facet_grid geom_col ggplot labs scale_fill_steps theme vars +#' @importFrom rlang check_dots_empty int +#' @importFrom tibble deframe lst +#' @importFrom tidyr replace_na +#' +#' @examples +#' tm = edc_example_ae() +#' load_list(tm) +#' ae_plot_grade_sum(df_ae=ae, df_enrol=enrolres) +#' ae_plot_grade_sum(df_ae=ae, df_enrol=enrolres, arm="ARM") +#' ae_plot_grade_sum(df_ae=ae, df_enrol=enrolres, arm="ARM", weights=c(1,1,3,6,10)) +ae_plot_grade_sum = function( + df_ae, ..., df_enrol, + low="#ffc425", high="#d11141", + weights=NULL, + arm=NULL, grade="AEGR", subjid="SUBJID" +){ + check_dots_empty() + assert_names_exists(df_ae, lst(subjid, grade)) + assert_names_exists(df_enrol, lst(subjid, arm)) + + weighted = !is.null(weights) + if(!weighted) weights=c(1,1,1,1,1) + assert(is.numeric(weights)) + assert(length(weights)==5) + + df_ae = df_ae %>% rename_with(tolower) %>% + select(subjid=tolower(subjid), grade=tolower(grade)) + df_enrol = df_enrol %>% rename_with(tolower) %>% + select(subjid=tolower(subjid), arm=tolower(arm)) + + df = df_enrol %>% + full_join(df_ae, by=tolower(subjid)) %>% + mutate(grade = fix_grade(grade), + weight = weights[grade] %>% replace_na(0.1)) %>% + arrange(subjid) + + default_arm = "All patients" + if(!is.null(arm)){ + npat = deframe(count(df_enrol, arm)) + npat["Total"] = sum(npat) + } else { + npat = int(!!default_arm:=nrow(df_enrol)) + } + + y_lab = "Count"; caption = NULL + if(weighted){ + y_lab = "Weighted count" + caption = paste0("Grade ", 1:5, " = ", weights, collapse=", ") + caption = paste("Weights: ", caption) + } + + pal = scales::pal_gradient_n(c(low, high))(seq(0, 1, length.out=5)) + + rtn = + df %>% + mutate(subjid = fct_infreq(factor(subjid), w=weight)) %>% + count(across(c(subjid, grade, any_of("arm"))), wt=weight) %>% + mutate( + n = ifelse(is.na(grade), 0.1, n), + grade = fct_rev(factor(grade)) + ) %>% + ggplot(aes(x=subjid, y=n, fill=grade)) + + scale_fill_manual(values=rev(pal)) + + geom_col() + + theme(axis.text.x=element_blank(), + axis.ticks.x=element_blank()) + + labs(x="Patient", y=y_lab, fill="AE grade", caption=caption) + + if(!is.null(arm)) rtn = rtn + facet_grid(cols=vars(arm), scales="free_x") + + rtn +} + + +#' @rdname ae_plot_grade_sum +#' @usage NULL +#' @export +ae_plot_grade_n = ae_plot_grade_sum + + +# Utils --------------------------------------------------------------------------------------- + +#' @importFrom dplyr na_if +fix_grade = function(x){ + as.numeric(na_if(as.character(x), "NA")) +} + + + +# Deprecated ---------------------------------------------------------------------------------- + + + + +#' Summary tables for AE +#' +#' `r lifecycle::badge("deprecated")` +#' +#' @inheritParams ae_table_soc +#' @inherit ae_table_soc seealso +#' +#' @return a crosstable +#' @importFrom dplyr across arrange count cur_column distinct filter full_join mutate rename_with select +#' @importFrom lifecycle deprecate_warn +#' @importFrom rlang check_dots_empty check_installed int +#' @importFrom tibble deframe +#' @export +#' +#' @examples +#' \dontrun{ +#' tm = edc_example_ae() +#' +#' ae_table_grade_n(df_ae=tm$ae, df_enrol=tm$enrolres) %>% +#' as_flextable() %>% +#' flextable::add_footer_lines("Percentages are given as the proportion of patients +#' presenting at least one AE of given grade") +#' +#' ae_table_grade_n(df_ae=tm$ae, df_enrol=tm$enrolres, arm=NULL) %>% +#' as_flextable(by_header=F) %>% +#' flextable::set_header_labels(values=c("","","N (%)")) +#' +#' #To get SAE only, filter df_ae first +#' tm$ae %>% filter(sae==TRUE) %>% ae_table_grade_n(df_enrol=tm$enrolres, arm=NULL) +#' } +ae_table_grade_n = function( + df_ae, ..., df_enrol, + arm="ARM", grade="AEGR", subjid="SUBJID", soc="AESOC", + total=FALSE, digits=0 +){ + deprecate_warn("0.5.0", "ae_table_grade_n()", 'ae_table_grade(variant="eq")') + check_installed("crosstable", "for `ae_table_grade_n()` to work.") + check_dots_empty() + + df_ae = df_ae %>% rename_with(tolower) %>% + select(subjid=tolower(subjid), soc=tolower(soc), grade=tolower(grade)) + df_enrol = df_enrol %>% rename_with(tolower) %>% + select(subjid=tolower(subjid), arm=tolower(arm)) + df = df_enrol %>% + full_join(df_ae, by=tolower(subjid)) %>% + arrange(subjid) %>% + mutate(grade = fix_grade(grade)) %>% + filter(!is.na(soc)) + + default_arm = "All patients" + # browser() + npat = int(!!default_arm:=nrow(df_enrol)) + if(!is.null(arm)){ + npat = deframe(count(df_enrol, arm)) + npat["Total"] = sum(npat) + } + total = if(total) "row" else FALSE + + if(!any(names(df)=="arm")) df$arm=default_arm %>% set_label("Treatment arm") + rtn = df %>% + distinct(subjid, arm, grade) %>% + mutate(arm) %>% + mutate(grade = ifelse(is.na(grade), "NA", paste("Grade", grade)) %>% + copy_label_from(grade)) %>% + crosstable::crosstable(grade, by=arm, total=total, + percent_pattern=crosstable::get_percent_pattern("none")) %>% + mutate(across(-(.id:variable), function(x){ + x = as.numeric(x) + tot = npat[cur_column()] + p = crosstable::format_fixed(x/tot, digits, percent=TRUE) + paste0(x, " (", p, ")") + })) + attr(rtn, "by_table")[] = npat[!is.na(names(npat)) & names(npat)!="Total"] #zarb que crosstable oublie les NA dans by_table non? + rtn +} + + + +#' Summary tables for AE by grade max +#' +#' `r lifecycle::badge("deprecated")` +#' +#' The function `ae_table_grade_max()` creates a summary table of the maximum AE grade experienced per each patient. +#' The resulting crosstable can be piped to `as_flextable()` to get a nicely formatted flextable. +#' +#' @inheritParams ae_table_soc +#' @inherit ae_table_soc seealso +#' +#' @return a crosstable (dataframe) +#' @export +#' @importFrom dplyr any_of arrange full_join if_else mutate recode select summarise +#' @importFrom lifecycle deprecate_warn +#' @importFrom rlang check_dots_empty check_installed +#' +#' @examples +#' +#' tm = edc_example_ae() +#' ae_table_grade_max(df_ae=tm$ae, df_enrol=tm$enrolres) +#' ae_table_grade_max(df_ae=tm$ae, df_enrol=tm$enrolres, arm=NULL) +#' +#' \dontrun{ +#' #you can use as_flextable() to get an HTML flextable +#' #you can use modificators modificators from the flextable package +#' library(flextable) +#' ae_table_grade_max(df_ae=tm$ae, df_enrol=tm$enrolres, arm=NULL) %>% +#' as_flextable() %>% +#' add_footer_lines("Percentages are given as the proportion of patients +#' presenting at most one AE of given grade") +#' ae_table_grade_max(df_ae=tm$ae, df_enrol=tm$enrolres) %>% +#' as_flextable(by_header="Both arms") %>% +#' highlight(i=~variable=="Grade 5", j=-1) +#' } +ae_table_grade_max = function( + df_ae, ..., df_enrol, + arm="ARM", subjid="SUBJID", soc="AESOC", grade="AEGR", total=TRUE, digits=0 +){ + check_installed("crosstable", "for `ae_table_grade_max()` to work.") + deprecate_warn("0.5.0", "ae_table_grade_max()", 'ae_table_grade(variant="max")') + check_dots_empty() + null_arm = is.null(arm) + + df_ae = df_ae %>% + select(subjid_=any_of2(subjid), soc_=any_of2(soc), grade_=any_of2(grade)) + df = df_enrol %>% + select(subjid_=any_of2(subjid), arm_=any_of2(arm)) %>% + full_join(df_ae, by="subjid_") %>% + arrange(subjid_) %>% + mutate( + grade_ = if_else(is.na(soc_), 0, fix_grade(grade_)), + ) %>% + summarise(grade_max = max_narm(grade_), .by=any_of(c("subjid_", "arm_"))) + + df %>% + mutate(grade_max = ifelse(is.na(grade_max), "NA", paste("Grade", grade_max)), + grade_max = recode(grade_max, "Grade 0"="No AE")) %>% + crosstable::apply_labels(grade_max = "Max grade") %>% + crosstable::crosstable(grade_max, by=any_of("arm_"), total=total, + percent_digits=digits, margin="col") +} + +#' Graphic representation of AEs by grade max +#' +#' `r lifecycle::badge("deprecated")` +#' +#' Produces a graphic representation of AE, counting the maximum grade each patient experienced, colored by treatment arm. Returns up to 3 representations if `arm!=NULL`. +#' +#' @inheritParams ae_table_soc +#' @inherit ae_table_soc seealso +#' @param proportion display proportion instead of count. +#' @param type the plots to be included. One of `c("stack", "dodge", "fill")`. +#' @param drop_levels whether to drop unused grade levels. +#' +#' @return a patchwork of ggplots +#' @importFrom dplyr any_of arrange distinct full_join mutate n select setdiff summarise +#' @importFrom ggplot2 aes geom_bar geom_col ggplot labs position_dodge scale_x_continuous scale_y_discrete theme waiver +#' @importFrom purrr map +#' @importFrom rlang check_dots_empty check_installed set_names +#' @export +#' +#' @examples +#' tm = edc_example_ae() +#' ae_plot_grade_max(df_ae=tm$ae, df_enrol=tm$enrolres) +#' ae_plot_grade_max(df_ae=tm$ae, df_enrol=tm$enrolres, type=c("dodge", "fill"), proportion=FALSE) +#' ae_plot_grade_max(df_ae=tm$ae, df_enrol=tm$enrolres, arm=NULL) + ggplot2::coord_flip() +#' +#' #you can use modificators from the patchwork package, like "&" +#' \dontrun{ +#' library(patchwork) +#' ae_plot_grade_max(df_ae=tm$ae, df_enrol=tm$enrolres) & labs(fill="Group") +#' } +ae_plot_grade_max = function( + df_ae, ..., df_enrol, + type = c("stack", "dodge", "fill"), + proportion = TRUE, + drop_levels = FALSE, + arm="ARM", subjid="SUBJID", soc="AESOC", grade="AEGR" +){ + check_installed("patchwork", "for `ae_plot_grade_max()` to work.") + check_dots_empty() + + df_ae = df_ae %>% + select(subjid=any_of2(subjid), soc=any_of2(soc), grade=any_of2(grade)) + a = df_enrol %>% + select(subjid=any_of2(subjid), arm=any_of2(arm)) %>% + full_join(df_ae, by="subjid") %>% + arrange(subjid) %>% + mutate(grade = ifelse(is.na(soc), 0, fix_grade(grade))) + + by_cols = if(is.null(arm)) "subjid" else c("subjid", "arm") + x = a %>% + summarise(grade_max = max_narm(grade), .by=any_of(by_cols)) %>% + mutate(grade_max = factor(grade_max, levels=0:5, labels=c("No AE", paste("Grade", 1:5)))) + + if(isTRUE(proportion)){ + type = setdiff(type, "fill") + x2 = x %>% + mutate(n_arm = n(), .by=arm) %>% + summarise(n=n(), p=n()/n_arm, + .by=c(grade_max, arm)) %>% + distinct() %>% + mutate(label = paste0("N=",n)) + p_list = type %>% set_names() %>% + map(~{ + if(.x=="dodge") .x = position_dodge(width=0.9) + p = + x2 %>% + ggplot(aes(y=grade_max, x=p, fill=arm, by=grade_max)) + + geom_col(position=.x) + + # geom_text(aes(label=label), position=.x, hjust=1) + + scale_y_discrete(drop=drop_levels) + + scale_x_continuous(labels=scales::percent) + + labs(y="Max AE grade experienced", x="Proportion of patients", fill="Treatment") + # StatProp = ggstats:::StatProp + # if(.x=="fill") p = + # p + geom_text(stat="prop", position = position_fill(.5)) + p + }) + } else { + if(is.null(arm)) type="stack" + p_list = type %>% set_names() %>% + map(~{ + y_lab = if(.x=="fill") "Proportion" else "Count" + p = + x %>% + ggplot(aes(y=grade_max, fill=arm, by=grade_max)) + + geom_bar(position=.x) + + scale_y_discrete(drop=drop_levels) + + scale_x_continuous(labels = if(.x=="fill") scales::percent else waiver()) + + labs(y="Max AE grade experienced", x=y_lab, fill="Treatment") + # StatProp = ggstats:::StatProp + # if(.x=="fill") p = + # p + geom_text(stat="prop", position = position_fill(.5)) + p + }) + } + + + + + patchwork::wrap_plots(p_list) + + patchwork::plot_layout(guides="collect") & + theme(legend.position="top") + +} diff --git a/R/ae_table_soc.R b/R/ae_table_soc.R new file mode 100644 index 0000000..1ffb8ba --- /dev/null +++ b/R/ae_table_soc.R @@ -0,0 +1,540 @@ + +#TODO min_percent=1 -> n minimal for percents ? +#TODO total by arm OK, total total aussi? +#TODO vline dans as_flextable ? + +#' Summary tables for AE by SOC +#' +#' The function `ae_table_soc()` creates a summary table of maximum AE grades for each patient according to term and SOC CTCAE. +#' The resulting dataframe can be piped to `as_flextable()` to get a nicely formatted flextable. +#' +#' @param df_ae adverse event dataset, one row per AE, containing subjid, soc, and grade. +#' @param df_enrol enrollment dataset, one row per patient, containing subjid (and arm if needed). All patients should be in this dataset. +#' @param variant one or several of `c("max", "sup", "eq")`. `max` computes the maximum AE grade per patient, `sup` computes the number of patients having experienced at least one AE of grade higher or equal to X, and `eq` computes the number of patients having experienced at least one AE of grade equal to X. +#' @param arm name of the treatment column in `df_enrol`. Case-insensitive. Can be set to `NULL`. +#' @param term name of the the CTCAE term column in `df_ae`. Case-insensitive. Can be set to `NULL`. +#' @param sort_by_count should the table be sorted by the number of AE or by SOC alphabetically. +#' @param total whether to add a `total` column for each arm. +#' @param showNA whether to display missing grades. +#' @param digits significant digits for percentages. +#' @param warn_miss whether to warn for missing values. +#' @param grade name of the AE grade column in `df_ae`. Case-insensitive. +#' @param soc name of the SOC column in `df_ae`. Case-insensitive. Grade will be considered 0 if missing (e.g. if patient if absent from `df_ae`). +#' @param subjid name of the patient ID in both `df_ae` and `df_enrol`. Case-insensitive. +#' @param ... unused +#' +#' @return a dataframe (`ae_table_soc()`) or a flextable (`as_flextable()`). +#' +#' @seealso [ae_table_grade_max()], [ae_table_grade_n()], [ae_table_soc()], [ae_plot_grade_max()], [ae_plot_grade_n()] +#' +#' @importFrom cli cli_warn +#' @importFrom dplyr across any_of arrange count cur_group filter full_join if_else mutate pull rename select summarise +#' @importFrom forcats fct_infreq +#' @importFrom glue glue +#' @importFrom purrr iwalk keep map +#' @importFrom rlang arg_match check_dots_empty ensym is_empty set_names +#' @importFrom tibble deframe lst +#' @importFrom tidyr build_wider_spec pivot_wider_spec unnest +#' @importFrom tidyselect matches +#' @export +#' +#' @examples +#' tm = edc_example_ae() +#' ae_table_soc(df_ae=tm$ae, df_enrol=tm$enrolres, term=NULL) +#' ae_table_soc(df_ae=tm$ae, df_enrol=tm$enrolres, term=NULL, arm=NULL) +#' +#' if (require("flextable")) { +#' +#' #the resulting flextable can be customized using the flextable package +#' ae_table_soc(tm$ae, df_enrol=tm$enrolres, total=FALSE) %>% +#' as_flextable() %>% +#' hline(i=~soc=="" & soc!=dplyr::lead(soc)) +#' ae_table_soc(tm$ae, df_enrol=tm$enrolres, term=NULL, sort_by_count=FALSE) %>% +#' as_flextable() %>% +#' bold(i=~soc=="Eye disorders") +#' ae_table_soc(tm$ae, df_enrol=tm$enrolres, term=NULL, arm=NULL) %>% +#' as_flextable() %>% +#' highlight(i=~soc=="Hepatobiliary disorders", j="all_patients_Tot") +#' } +ae_table_soc = function( + df_ae, ..., df_enrol, + variant=c("max", "sup", "eq"), + arm=NULL, term=NULL, + sort_by_count=TRUE, total=TRUE, showNA=TRUE, digits=0, warn_miss=FALSE, + grade="AEGR", soc="AESOC", subjid="SUBJID" +){ + check_dots_empty() + default_arm = set_label("All patients", "Treatment arm") + null_term = is.null(term) + null_arm = is.null(arm) + variant = arg_match(variant) + + assert_names_exists(df_ae, lst(subjid, term, soc, grade)) + assert_names_exists(df_enrol, lst(subjid, arm)) + + label_missing_soc = "Missing SOC" + label_missing_pat = "No Declared AE" + + if(variant!="max" && missing(total) && total){ + cli_warn("Total has been set to `FALSE` as totals are not very interpretable + when {.arg variant} is {.val sup} or {.val eq}. Set `total=TRUE` + explicitly to silence this warning.") + total=FALSE + } + + df_ae = df_ae %>% + select(subjid_=any_of2(subjid), soc_=any_of2(soc), + term_=any_of2(term), grade_=any_of2(grade)) %>% + mutate(soc_ = if_else(soc_ %in% c(0, NA), label_missing_soc, soc_)) + df_enrol = df_enrol %>% + select(subjid_=any_of2(subjid), arm_=any_of2(arm)) %>% + mutate(arm_ = if(is.null(.env$arm)) default_arm else .data$arm_) + + df = df_enrol %>% + full_join(df_ae, by="subjid_") %>% + arrange(subjid_) %>% + mutate( + arm_ = to_snake_case(arm_), + soc_ = if_else(!subjid_ %in% df_ae$subjid_, label_missing_pat, soc_) + ) + + #check missing data + if(warn_miss){ + miss = names(df) %>% set_names() %>% map(~{ + df %>% filter(is.na(!!ensym(.x))) %>% pull(subjid_) %>% unique() %>% sort() + }) %>% keep(~!is_empty(.x)) + miss %>% iwalk(~{ + cli_warn("{.fn ae_table_soc}: Missing values in column {.val {.y}} for patients {.val {.x}}.", + class="edc_ae_missing_values_warning") + }) + } + + arm_count = df_enrol %>% + count(arm_) %>% + deframe() %>% as.list() + arm_count2 = arm_count %>% + set_names(to_snake_case) + + rtn = df %>% + # filter(subjid_==126) %>% + # filter(arm_=="crt_atezolizumab") %>% + summarise(calc = evaluate_grades(grade_, variant), + .by=any_of(c("subjid_", "arm_", "soc_", "term_"))) %>% + unnest(calc) %>% + mutate(soc_ = soc_ %>% fct_infreq(w=Tot) %>% + fct_last(label_missing_soc, label_missing_pat)) %>% + summarise( + across(c(matches("^G\\d$"), any_of(c("NA", "Tot"))), ~{ + n = sum(.x) + n_arm = arm_count2[[cur_group()$arm_]] + label = glue("{n} ({p})", p=percent(n/n_arm, digits)) + label[n==0] = NA + label + }), + .by=any_of(c("arm_", "soc_", "term_")) + ) %>% + arrange(arm_, soc_) + + if(!total) rtn = rtn %>% select(-Tot) + if(!showNA) rtn = rtn %>% select(-"NA") + if(!sort_by_count) rtn = rtn %>% mutate(soc_=as.character(soc_)) %>% arrange(arm_, soc_) + + spec = rtn %>% + build_wider_spec(names_from=arm_, + values_from=c(matches("^G\\d$"), any_of(c("NA", "Tot"))), + names_glue="{arm_}_{.value}") %>% + arrange(.name) + rtn = rtn %>% + rename(soc=soc_) %>% + pivot_wider_spec(spec) %>% + add_class("ae_table_soc") + + attr(rtn, "header") = + glue("{a} (N={b})", a=names(arm_count), b=arm_count) %>% + set_names(to_snake_case(names(arm_count))) %>% + as.character() + + rtn +} + + +# https://coolors.co/palette/dbe5f1-b8cce4-f2dcdb-e5b9b7-ebf1dd-d7e3bc-e5e0ec-ccc1d9-dbeef3-b7dde8 +#' Turns an `ae_table_soc` object into a formatted `flextable` +#' +#' @param x a dataframe, resulting of `ae_table_soc()` +#' @param arm_colors colors for the arm groups +#' @param padding_v a numeric of lenght up to 2, giving the vertical padding of body (1) and header (2) +#' +#' @return a formatted flextable +#' @rdname ae_table_soc +#' @exportS3Method flextable::as_flextable +#' +#' @importFrom dplyr case_match lag lead transmute +#' @importFrom purrr map map_int +#' @importFrom rlang check_installed set_names +#' @importFrom stringr str_detect str_replace_all +#' @importFrom tibble as_tibble_col +#' @importFrom tidyr separate_wider_regex +as_flextable.ae_table_soc = function(x, + arm_colors=c("#f2dcdb", "#dbe5f1", "#ebf1dd", "#e5e0ec"), + padding_v = NULL){ + check_installed("flextable") + if (missing(padding_v)) padding_v = getOption("crosstable_padding_v", padding_v) + table_ae_header = attr(x, "header") + if(FALSE){ + arm_cols = names(table_ae_header) %>% set_names() %>% + map_int(~{ + pattern = paste0("^", .x, "_(G\\d|NA|Tot)$") + sum(str_detect(names(x), pattern)) + }) + table_ae_header = table_ae_header[arm_cols>0] + arm_cols = arm_cols[arm_cols>0] + + col1 = names(x) %>% str_detect(names(table_ae_header)[1]) %>% which() %>% min() - 1 + colwidths = c(col1, arm_cols) + header_labels = set_names(names(x)) %>% map(~str_replace_all(.x, ".*_", "")) + header_labels$soc = "CTCAE SOC" + header_labels$term = "CTCAE v4.0 Term" + } + # https://github.com/tidyverse/tidyr/issues/1551 + header_df = names(x) %>% + as_tibble_col("col_keys") %>% + separate_wider_regex(col_keys, c(h1 = ".*", "_", h2 = ".*"), too_few="align_start", cols_remove=FALSE) %>% + transmute( + col_keys, + row1 = case_match(h1, + "soc" ~ "", + "term" ~ "", + .default=table_ae_header[h1]), + row2 = case_match(h1, + "soc" ~ "CTCAE SOC", + "term" ~ "CTCAE v4.0 Term", + .default=h2) + ) + + col1 = header_df$col_keys %in% c("soc", "term") %>% which() %>% max() + + sep_cols = with(header_df, !col_keys %in% c("soc", "term") & row1!=lead(row1)) %>% + which() %>% unname() %>% c(ncol(x)) + + rtn = x %>% + flextable::flextable() %>% + flextable::set_header_df(mapping=header_df) %>% + # flextable::hline_top(part="header") %>% + flextable::hline_bottom(part="header") %>% + flextable::merge_h(part="header") %>% + # flextable::set_header_labels(values=header_labels) %>% + # flextable::add_header_row(values=c(" ", table_ae_header), colwidths = colwidths) %>% + flextable::align(i=1, part="header", align="center") %>% + flextable::align(j=seq(col1), part="all", align="right") %>% + flextable::padding(padding.top=0, padding.bottom=0) %>% + flextable::set_table_properties(layout="autofit") %>% + flextable::fontsize(size=8, part="all") %>% + flextable::bold(part="header") + if (length(padding_v) >= 1) { + rtn = flextable::padding(rtn, padding.top=padding_v[1], padding.bottom=padding_v[1], part="body") + } + if (length(padding_v) == 2) { + rtn = flextable::padding(rtn, padding.top=padding_v[2], padding.bottom=padding_v[2], part="header") + } + # a = cumsum(colwidths)[-1] + a = sep_cols + for(i in seq_along(a)){ + from = lag(a, default=col1)[i] + 1 + to = a[i] + rtn = rtn %>% flextable::bg(j=seq(from, to), bg = arm_colors[i], part="all") + } + + rtn +} + + +#' Graphic representation of AEs by soc (Butterfly plot) +#' +#' Produces a graphic representation of AE, counting the maximum grade each patient experienced, colored by treatment arm. Returns up to 3 representations if `arm!=NULL`. +#' +#' The function `butterfly_plot()` creates a summary table of the maximum AE grade experienced per each patient. +#' The resulting crosstable can be piped to `as_flextable()` to get a nicely formatted flextable. +#' +#' @inheritParams ae_table_soc +#' @inherit ae_table_soc seealso +#' @param severe name of the logical column in `df_ae` telling whether an AE is severe. Case-insensitive. +#' @param sort_by either "total" or "severe" +#' @param range_min The minimum value for the upper limit of the x-axis range. Set to `1` to always include 100%. +#' +#' @return a crosstable (dataframe) +#' @export +#' @importFrom cli cli_abort +#' @importFrom dplyr any_of arrange count filter full_join left_join mutate select summarise +#' @importFrom forcats fct_reorder +#' @importFrom ggplot2 aes facet_grid geom_blank geom_col ggplot labs scale_x_continuous theme unit vars +#' @importFrom glue glue +#' @importFrom rlang arg_match check_dots_empty +#' @importFrom scales label_percent +#' @importFrom stats na.omit +#' @importFrom stringr str_remove +#' @importFrom tibble lst +#' +#' @examples +#' +#' tm = edc_example_ae(N=100) +#' load_list(tm) +#' +#' ae2 = ae %>% +#' dplyr::mutate(serious = sae=="Yes") +#' +#' ae2 %>% +#' butterfly_plot(df_enrol=enrolres, range_min=0.5) +#' +#' ae2 %>% +#' butterfly_plot(df_enrol=enrolres, severe="serious") + +#' ggplot2::labs(caption="Darker areas represent Serious Adverse Events") +butterfly_plot = function( + df_ae, ..., df_enrol, severe=NULL, sort_by=c("total", "severe"), range_min=NULL, + arm="ARM", subjid="SUBJID", soc="AESOC" +){ + check_dots_empty() + sort_by = arg_match(sort_by) + + assert_names_exists(df_ae, lst(subjid, soc, severe)) + assert_names_exists(df_enrol, lst(subjid, arm)) + + df_ae = df_ae %>% + select(subjid_=any_of2(subjid), soc_=any_of2(soc), + severe_=any_of2(severe)) %>% + mutate(severe_ = if(is.null(severe)) NA else severe_) + df_enrol = df_enrol %>% + select(subjid_=any_of2(subjid), arm_=any_of2(arm)) + df = df_ae %>% + full_join(df_enrol, by="subjid_") %>% + filter(!is.na(soc_)) %>% + arrange(subjid_) + + if(!is.factor(df_enrol$arm_)) df_enrol$arm_ = factor(df_enrol$arm_) + + arms = df_enrol$arm_ %>% unique() %>% na.omit() + if(length(arms)!=2){ + cli_abort(c("{.fn EDCimport::butterfly_plot} needs exactly 2 arms.", + i="Arms: {.val {arms}}"), + class="edc_butterfly_two_arms_error") + } + if(!is.null(severe)){ + if(!is.logical(df_ae$severe_)){ + cli_abort(c("{.arg severe} should be a logical column, not a {.type {df_ae$severe_}}. Did you forget to mutate it with `==`?"), + class="edc_butterfly_serious_lgl_error") + } + if(!any(df_ae$severe_)){ + cli_warn(c("All {.arg severe} values are FALSE."), + class="edc_butterfly_serious_false_warning") + } + } + + df_arm = df_enrol %>% + count(arm_, name="n_arm") %>% + mutate(label=glue("{arm_} (N={n_arm})") %>% fct_reorder(as.numeric(arm_))) + left_arm = levels(arms)[1] + + a = df %>% + summarise(any_ae = TRUE, + any_severe = any(severe_, na.rm=TRUE), + .by=any_of(c("subjid_", "arm_", "soc_"))) %>% + summarise(n_ae = sum(any_ae, na.rm=TRUE), + n_severe = sum(any_severe, na.rm=TRUE), + .by=any_of(c("arm_", "soc_"))) %>% + left_join(df_arm, by="arm_") %>% + mutate( + n_ae = n_ae * ifelse(arm_==left_arm, -1, 1), + n_severe = n_severe * ifelse(arm_==left_arm, -1, 1), + pct_ae = n_ae/n_arm, + pct_severe = n_severe/n_arm, + soc_ = fct_reorder(soc_, abs(pct_ae), .fun=max, .na_rm=TRUE), + ) + + a %>% arrange(soc_) + a %>% arrange(abs(pct_ae)) + if(sort_by=="severe") a$soc_ = fct_reorder(a$soc_, abs(a$pct_severe), .fun=max) + + label_percent_positive = \(x) label_percent()(x) %>% str_remove("-") + + layer_blank = NULL + if(!is.null(range_min)){ + data_blank = a %>% summarise(pct_ae = ifelse(arm_==left_arm, -range_min, range_min), + .by=c(label, soc_)) + layer_blank = geom_blank(aes(x=pct_ae), data=data_blank) + } + layer_severe = NULL + if(!is.null(severe)){ + layer_severe = geom_col(aes(x=pct_severe), color="grey40", width=0.6) + } + + a %>% + ggplot(aes(y=soc_, fill=label)) + + geom_col(aes(x=pct_ae), alpha=0.6) + + layer_severe + + layer_blank + + scale_x_continuous(labels=label_percent_positive) + + facet_grid(cols=vars(label), scales="free_x") + + labs(y=NULL, fill=NULL, x="Proportion of patients presenting at least 1 adverse event") + + theme( + legend.position="none", + panel.spacing.x=unit(1, "mm") + ) +} + + +#' @rdname butterfly_plot +#' @usage ae_plot_soc(df_ae, ..., df_enrol, severe, sort_by, range_min, arm, subjid, soc) +#' @export +ae_plot_soc = butterfly_plot + + +# Utils --------------------------------------------------------------------------------------- + + +#' for each patient/soc, detect if each grade satisfies the specified +#' condition (max/eq/sup) +#' @importFrom purrr map_lgl +#' @importFrom rlang set_names +#' @importFrom tibble as_tibble_row +#' @importFrom tidyr replace_na +#' @noRd +#' @keywords internal +evaluate_grades = function(gr, variant){ + inner_calc = switch(variant, max=~max_narm(gr) == .x, + sup=~any(gr >= .x, na.rm=TRUE), + eq=~any(gr == .x, na.rm=TRUE)) + n = c(1:5) %>% set_names(paste0("G",1:5)) %>% map_lgl(inner_calc) + n_na = c("NA"=all(is.na(n))) + n = replace_na(n, FALSE) + n_tot = c(Tot=sum(c(n, n_na), na.rm=TRUE)) + c(n, n_na, n_tot) %>% + as_tibble_row() +} + +# Legacy -------------------------------------------------------------------------------------- + +#' @importFrom cli cli_warn +#' @importFrom dplyr across any_of arrange count cur_group filter full_join if_else mutate pull rename select summarise +#' @importFrom forcats fct_infreq fct_relevel +#' @importFrom glue glue +#' @importFrom purrr iwalk keep map map_lgl +#' @importFrom rlang arg_match check_dots_empty ensym is_empty set_names +#' @importFrom tibble as_tibble_row deframe lst +#' @importFrom tidyr build_wider_spec pivot_wider_spec replace_na unnest +#' @importFrom tidyselect matches +#' @keywords internal +ae_table_soc_legacy = function( + df_ae, ..., df_enrol, + variant=c("max", "sup", "eq"), + arm="ARM", term="AETERM", soc="AESOC", grade="AEGR", subjid="SUBJID", + sort_by_ae=TRUE, total=TRUE, digits=0, warn_miss=FALSE +){ + check_dots_empty() + default_arm = set_label("All patients", "Treatment arm") + null_term = is.null(term) + null_arm = is.null(arm) + variant = arg_match(variant) + + assert_names_exists(df_ae, lst(subjid, term, soc, grade)) + assert_names_exists(df_enrol, lst(subjid, arm)) + + + label_missing_soc = "Missing SOC" + label_missing_pat = "No Declared AE" + + df_ae = df_ae %>% + select(subjid_=any_of2(subjid), soc_=any_of2(soc), + term_=any_of2(term), grade_=any_of2(grade)) %>% + mutate(soc_ = if_else(soc_ %in% c(0, NA), label_missing_soc, soc_)) + df_enrol = df_enrol %>% + select(subjid_=any_of2(subjid), arm_=any_of2(arm)) %>% + mutate(arm_ = if(is.null(.env$arm)) default_arm else .data$arm_) + + df = df_enrol %>% + full_join(df_ae, by="subjid_") %>% + arrange(subjid_) %>% + mutate( + arm_ = to_snake_case(arm_), + soc_ = if_else(!subjid_ %in% df_ae$subjid_, label_missing_pat, soc_), + # soc_ = fct_infreq(soc_) %>% fct_relevel(label_missing_soc, + # label_missing_pat, after=Inf) + ) + + #check missing data + if(warn_miss){ + miss = names(df) %>% set_names() %>% map(~{ + df %>% filter(is.na(!!ensym(.x))) %>% pull(subjid_) %>% unique() %>% sort() + }) %>% keep(~!is_empty(.x)) + miss %>% iwalk(~{ + cli_warn("{.fn ae_table_soc}: Missing values in column {.val {.y}} for patients {.val {.x}}.", + class="edc_ae_missing_values_warning") + }) + } + ##_______________________________________________________________________ + + arm_count = df_enrol %>% + count(arm_) %>% + deframe() %>% as.list() + arm_count2 = arm_count %>% + set_names(to_snake_case) + + + #' for each patient/soc, detect if each grade satisfies the specified + #' condition (max/eq/sup) + evaluate_grades = function(gr, variant){ + inner_calc = switch(variant, max=~max_narm(gr) == .x, + sup=~any(gr >= .x, na.rm=TRUE), + eq=~any(gr == .x, na.rm=TRUE)) + n = c(1:5) %>% set_names(paste0("G",1:5)) %>% map_lgl(inner_calc) + n_na = c("NA"=all(is.na(n))) + n = replace_na(n, FALSE) + n_tot = c(Tot=sum(c(n, n_na), na.rm=TRUE)) + c(n, n_na, n_tot) %>% + as_tibble_row() + } + + # soc_ = fct_infreq(soc_) %>% fct_relevel(label_missing_soc, label_missing_pat, after=Inf) + + rtn = df %>% + # filter(subjid_==126) %>% + # filter(arm_=="crt_atezolizumab") %>% + summarise(calc = evaluate_grades(grade_, variant), + .by=any_of(c("subjid_", "arm_", "soc_", "term_"))) %>% + unnest(calc) %>% + mutate(soc_ = soc_ %>% fct_infreq(w=Tot) %>% + fct_relevel(label_missing_soc, label_missing_pat, after=Inf)) %>% + summarise( + across(c(matches("^G\\d$"), any_of(c("NA", "Tot"))), ~{ + n = sum(.x) + n_arm = arm_count2[[cur_group()$arm_]] + label = glue("{n} ({p})", p=scales::percent(n/n_arm, 1)) + label[n==0] = NA + label + }), + .by=any_of(c("arm_", "soc_", "term_")) + ) %>% + arrange(arm_, soc_) + + if(!total) rtn = rtn %>% select(-Tot) + if(!showNA) rtn = rtn %>% select(-"NA") + if(!sort_by_count) rtn = rtn %>% mutate(soc_=as.character(soc_)) %>% arrange(arm_, soc_) + + spec = rtn %>% + build_wider_spec(names_from=arm_, + values_from=c(matches("^G\\d$"), any_of(c("NA", "Tot"))), + names_glue="{arm_}_{.value}") %>% + arrange(.name) + rtn = rtn %>% + rename(soc=soc_) %>% + pivot_wider_spec(spec) %>% + add_class("ae_table_soc") + + attr(rtn, "header") = + glue("{a} (N={b})", a=names(arm_count), b=arm_count) %>% + set_names(to_snake_case(names(arm_count))) %>% + as.character() + + rtn +} + +# https://www.acpjournals.org/doi/full/10.7326/0003-4819-141-10-200411160-00009