clinical utils (WIP)

DESCRIPTION

@@ -32,6 +32,7 @@ Imports:
     lifecycle
 Suggests: 
     callr,
+    crosstable,
     gtools,
     htmlwidgets,
     janitor,

NAMESPACE

@@ -3,10 +3,16 @@
 S3method(print,tm_database)
 S3method(summary,common_cols)
 export("%>%")
+export(ae_plot_grade_max)
+export(ae_table_grade_max)
+export(ae_table_grade_n)
+export(ae_table_soc)
+export(as_flextable.ae_table_soc)
 export(assert_no_duplicate)
 export(build_lookup)
 export(check_subjid)
 export(edc_example)
+export(edc_example_ae)
 export(edc_example_mixed)
 export(edc_example_plot)
 export(edc_options)
@@ -34,6 +40,7 @@ export(save_plotly)
 export(split_mixed_datasets)
 export(tibble)
 export(unify)
+export(waterfall_plot)
 importFrom(cli,cat_rule)
 importFrom(cli,cli_abort)
 importFrom(cli,cli_bullets)
@@ -50,6 +57,7 @@ importFrom(dplyr,bind_rows)
 importFrom(dplyr,count)
 importFrom(dplyr,desc)
 importFrom(dplyr,filter)
+importFrom(dplyr,full_join)
 importFrom(dplyr,group_by)
 importFrom(dplyr,left_join)
 importFrom(dplyr,mutate)
@@ -58,6 +66,7 @@ importFrom(dplyr,na_if)
 importFrom(dplyr,pull)
 importFrom(dplyr,relocate)
 importFrom(dplyr,rename)
+importFrom(dplyr,rename_with)
 importFrom(dplyr,rowwise)
 importFrom(dplyr,select)
 importFrom(dplyr,slice)
@@ -68,10 +77,14 @@ importFrom(dplyr,ungroup)
 importFrom(forcats,as_factor)
 importFrom(ggplot2,aes)
 importFrom(ggplot2,facet_wrap)
+importFrom(ggplot2,geom_bar)
 importFrom(ggplot2,geom_line)
 importFrom(ggplot2,geom_point)
 importFrom(ggplot2,ggplot)
 importFrom(ggplot2,labs)
+importFrom(ggplot2,scale_x_continuous)
+importFrom(ggplot2,theme)
+importFrom(ggplot2,waiver)
 importFrom(glue,glue)
 importFrom(haven,read_xpt)
 importFrom(labelled,var_label)
@@ -129,6 +142,7 @@ importFrom(stringr,str_starts)
 importFrom(stringr,str_subset)
 importFrom(stringr,str_trim)
 importFrom(tibble,as_tibble)
+importFrom(tibble,deframe)
 importFrom(tibble,lst)
 importFrom(tibble,tibble)
 importFrom(tidyr,pivot_longer)

R/ae_table_grade.R

@@ -0,0 +1,179 @@
+
+
+# Grade maximum -------------------------------------------------------------------------------
+
+
+#' Summary tables for AE by grade max
+#' 
+#' 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.
+#' 
+#' The function `ae_plot_grade_max()` creates summary plots of maximum AE grades in up to 3 different ways. 
+#'
+#'
+#' @param df input data, one row per event
+#' @param arm name of the treatment column in `df`. Case-insensitive. Can be set to `NULL` to not group.
+#' @param soc name of the SOC column in `df`. Case-insensitive. Grade will be considered 0 is missing.
+#' @param subjid,grade names of the other relevant columns in `df`. Case-insensitive. 
+#' @param total whether to add totals
+#' @param digits number of signigicant digits for percentages
+#'
+#' @return a crosstable (dataframe)
+#' @export
+#'
+#' @examples
+#' \dontrun{
+#' 
+#' tm = edc_example_ae()
+#' ae_table_grade_max(df_ae=tm$ae, df_enrol=tm$enrolres)
+#' ae_plot_grade_max(df_ae=tm$ae, df_enrol=tm$enrolres)
+#' 
+#' # 1) Apply table functions
+#' #you can use as_flextable() to get an HTML flextable
+#' #you can use modificators modificators from the flextable package
+#' ae_table_grade_max(df_ae=ae, df_enrol=enrolres, arm=NULL) %>% 
+#'   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=ae, df_enrol=enrolres) %>%
+#'   as_flextable(by_header="Both arms") %>% 
+#'   highlight(i=~variable=="Grade 5", j=-1)
+#'   
+#' # 2) Apply plot functions
+#' #you can choose the type
+#' #you can use modificators from the patchwork package, like "&"
+#' ae_plot_grade_max(df_ae=ae, df_enrol=enrolres) & labs(fill="Group")
+#' ae_plot_grade_max(df_ae=ae, df_enrol=enrolres, type=c("dodge", "fill"))
+#' ae_plot_grade_max(df_ae=ae, df_enrol=enrolres, arm=NULL) + coord_flip()
+#' }
+ae_table_grade_max = function(
+    df_ae, df_enrol, 
+    arm="ARM", subjid="SUBJID", soc="AESOC", grade="AEGR", total=TRUE, digits=0
+){
+
+
+  df_ae = df_ae %>% rename_with(tolower) %>%
+    select(subjid=tolower(subjid), soc=tolower(soc), grade=tolower(grade))
+  df = df_enrol %>% rename_with(tolower) %>%
+    select(subjid=tolower(subjid), arm=tolower(arm)) %>%
+    full_join(df_ae, by=tolower(subjid)) %>% 
+    arrange(subjid) %>% 
+    mutate(grade = ifelse(is.na(soc), 0, grade))
+
+  df %>% 
+    summarise(grade_max = max_narm(grade), .by=c(subjid, arm)) %>% 
+    mutate(grade_max = ifelse(is.na(grade_max), "NA", paste("Grade", grade_max))) %>% 
+    crosstable::apply_labels(grade_max = "Max grade") %>% 
+    crosstable::crosstable(grade_max, by=arm, total=total, percent_digits=digits, margin="col") 
+}
+
+#' @rdname ae_table_grade_max
+#' @return a patchwork of ggplots
+#' @importFrom ggplot2 aes geom_bar ggplot labs scale_x_continuous theme waiver
+#' @export
+ae_plot_grade_max = function(
+    df_ae, df_enrol, type = c("stack", "dodge", "fill"),
+    arm="ARM", subjid="SUBJID", soc="AESOC", grade="AEGR"
+){
+
+  df_ae = df_ae %>% rename_with(tolower) %>%
+    select(subjid=tolower(subjid), soc=tolower(soc), grade=tolower(grade)) 
+  x = df_enrol %>% rename_with(tolower) %>%
+    select(subjid=tolower(subjid), arm=tolower(arm)) %>%
+    full_join(df_ae, by=tolower(subjid)) %>% 
+    arrange(subjid) %>% 
+    mutate(grade = ifelse(is.na(soc), 0, grade)) %>% 
+    summarise(grade_max = max_narm(grade), .by=c(subjid, arm)) %>% 
+    mutate(grade_max = ifelse(is.na(grade_max), "NA", paste("Grade", grade_max)))
+  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=factor(grade_max))) +
+        geom_bar(position=.x) +
+        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")
+
+}
+# Nb of grades --------------------------------------------------------------------------------
+
+
+#' Title
+#' 
+#' @param df_ae adverse event table, one row per AE, containing subjid, soc, and grade
+#' @param df_enrol enrollment table, one row per patient, containing subjid (and arm if needed)
+#' @inheritParams ae_table_grade_max
+#'
+#' @return a crosstable
+#' @importFrom dplyr arrange count filter full_join rename_with select
+#' @importFrom tibble deframe
+#' @export
+#'
+#' @examples
+#' \dontrun{
+#' library(flextable)
+#' tm = edc_example_ae()
+#' load_list(tm)
+#' ae_table_grade_n(df_ae=ae, df_enrol=enrolres) %>% 
+#'   as_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=ae, df_enrol=enrolres, arm=NULL) %>% 
+#'   af(by_header=F) %>% 
+#'   set_header_labels(values=c("","N (%)")) 
+#'   
+#' #To get SAE only, filter df_ae first
+#' ae %>% filter(AESER=="1-Yes") %>% ae_table_grade_n(df_enrol=enrolres, arm=NULL)
+#' }
+ae_table_grade_n = function(
+    df_ae, df_enrol, 
+    arm="ARM", grade="AEGR", subjid="SUBJID", soc="AESOC",
+    total=FALSE, digits=0
+){
+  df_ae = df_ae %>% rename_with(tolower) %>%
+    select(subjid=tolower(subjid), soc=tolower(soc), grade=tolower(grade))
+  df = df_enrol %>% rename_with(tolower) %>%
+    select(subjid=tolower(subjid), arm=tolower(arm)) %>%
+    full_join(df_ae, by=tolower(subjid)) %>% 
+    arrange(subjid) %>% 
+    filter(!is.na(soc)) 
+
+  default_arm = "All patients" 
+  # `:=` = rlang::`:=`
+  npat = rlang::int(!!default_arm:=nrow(df_enrol)) 
+  if(!is.null(arm)){
+    npat = deframe(count(df_enrol, !!ensym(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 = format_fixed(x/tot, digits, percent=TRUE)
+      paste0(x, " (", p, ")")
+    }))
+  attr(rtn, "by_table")[] = npat[names(npat)!="Total"]
+  rtn
+}
+
+# ae_table_grade_n(ae, df_enrol=enrolres)
+# ae_table_grade_n(ae, df_enrol=enrolres, total=TRUE)
+# ae_table_grade_n(ae, df_enrol=enrolres, arm=NULL)
+# ae_table_grade_n(ae, df_enrol=enrolres, arm=NULL, total=TRUE)
+# ae %>% filter(AESER=="1-Yes") %>% ae_table_grade_n(df_enrol=enrolres, total=TRUE) %>% af