R/bivar_plot.R

In AdrienLeGuillou/descriptor: Simple and tidy data description

plot_describe_bivar <- function(y, x,  names = c("", ""), max_lvl = 4) {
  ls <- dispatch_bivar(y, x, "plot_describe")
  x <- ls[[1]]
  y <- ls[[2]]
  f <- ls[[3]]
  
  f(y, x, names = names, max_lvl = max_lvl)
}

plot_describe_bivar_quant <- function(y, x, names = c("", ""), ...) {
  df <- data.frame(x, y)
  
  g_scatter <- ggpubr::ggscatterhist(df, x = "x", y = "y", alpha = 0.8,
                                     color = "dimgrey",
                                     add = "loess",
                                     add.params = list(fill = "lightgrey",
                                                       color = "black"),
                                     margin.params = list(fill = "lightgrey"),
                                     xlab = names[2],
                                     ylab = names[1],
                                     conf.int = TRUE)
  
  g_table <- describe_bivar(y, x) %>% 
    dplyr::mutate_if(is.numeric, signif, 3) %>%
    ggpubr::ggtexttable(rows = NULL)
  
  ggpubr::ggarrange(g_scatter, g_table, nrow = 2) %>% 
    ggpubr::annotate_figure(
      top = ggpubr::text_grob(paste("Exploration of vars:",
                                     names[1], "and", names[2]),
                              color = "black", face = "bold"))
                
}

plot_describe_bivar_categ <- function(y, x, names = c("", ""), max_lvl = 4, ...) {
  # convert x and y to factors and keep only the "max_lvl" more common levels
  x <- as.factor(x) 
  y <- as.factor(y)
  
  g_desc <- describe_bivar(y, x) %>%
    dplyr::mutate_if(is.numeric, signif, 3) %>%
    t() %>%
    ggpubr::ggtexttable()
  
  if (length(levels(x)) > max_lvl) {
    x <- forcats::fct_lump(x, n = max_lvl - 1, ties.method = "first")
  } 
  if (length(levels(y)) > max_lvl) {
    y <- forcats::fct_lump(y, n = max_lvl - 1, ties.method = "first")
  } 
  
  df <- table(y, x) %>%
    broom::tidy() %>% 
    dplyr::select(Group = 1, Level = 2, Count = n) %>%
    dplyr::arrange(desc(Count)) %>% 
    dplyr::group_by(Group) %>% 
    dplyr::mutate(Freq = Count / sum(Count))
  
  g_bar <- df %>%
    ggpubr::ggbarplot(x = "Group", y = "Freq", fill = "Level",
                      position = ggplot2::position_dodge(0.7),
                      xlab = names[2],
                      collab = names[1]) +
    ggpubr::rotate()
  
  g_tab <- df %>% 
    head(max_lvl * 2) %>% 
    dplyr::mutate_if(is.numeric, signif, 3) %>%
    ggpubr::ggtexttable(rows = NULL)
  
  ggpubr::ggarrange(g_bar,
                    ggpubr::ggarrange(g_tab, g_desc, nrow = 2),
                    ncol = 2) %>%
    ggpubr::annotate_figure(
      top = ggpubr::text_grob(paste("Exploration of vars:",
                                    names[1], "and", names[2]),
                              color = "black", face = "bold"))
}

plot_describe_bivar_both <- function(y, x, names = c("", ""), max_lvl = 4, ...) {
  x <- as.factor(x)
  if (length(levels(x)) > max_lvl) {
    x <- forcats::fct_lump(x, n = max_lvl - 1, ties.method = "first")
  } 
  
  # density plot
  g_dens <- data.frame(x, y) %>% 
    ggpubr::ggdensity(x = 'y', fill = "x", color = "x")

  # metrics
  g_tab <- describe_bivar(y, x, max_lvl = max_lvl) %>%
    dplyr::mutate_if(is.numeric, signif, 3) %>%
    t() %>%
    ggpubr::ggtexttable()
  
  # plot arrangement
  ggpubr::ggarrange(g_dens, g_tab, ncol = 2) %>%
    # final plot title
    ggpubr::annotate_figure(
      top = ggpubr::text_grob(paste("Exploration of vars:",
                              names[1], "and", names[2]),
                              color = "black", face = "bold"))
}