R/univar_plot.R

In AdrienLeGuillou/descriptor: Simple and tidy data description

plot_describe <- function (x, ...) {
  UseMethod("plot_describe", x)
}

plot_desc_quant <- function(x, name = "", ...) {
  # density plot
  g_dens <- ggpubr::ggdensity(as.data.frame(x), 'x', fill = "#337ab7",
                              add = "median")
  # metrics
  g_tab <- describe(x) %>%
    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 var:",
                                                          name),
                                                    color = "black", face = "bold"))
}

plot_describe.numeric <- function(x, name = "", ...) {
  plot_desc_quant(x, name)
}

plot_describe.Date <- function(x, name = "", ...) {
  plot_desc_quant(x, name)
}

plot_describe.factor <- function(x, name = "", max_lvl = 5, ...) {
  tab <- table(x) %>%
    broom::tidy() %>%
    dplyr::select(Level = 1, Count = n) %>%
    dplyr::arrange(desc(Count)) 

  if (nrow(tab) > max_lvl){
    others <- sum(tab$Count[max_lvl:nrow(tab)], na.rm = TRUE)
    tab <- head(tab, max_lvl-1)
    tab$Level <- as.character(tab$Level)
    tab <- rbind(tab, c("others", others))
  }

  tab$Level <- as.character(tab$Level)
  tab <- rbind(tab, c("NA", sum(is.na(x))))
  tab$Count <- as.numeric(tab$Count)
  
  tab <- tab %>% 
    dplyr::mutate(Freq = Count / length(x))

  g_tab <- tab %>%
    ggpubr::ggtexttable(rows = NULL)

  g_bar <- ggpubr::ggbarplot(tab, x = "Level", y = "Count", fill = "#337ab7") +
    ggpubr::rotate()

  g_desc <- describe(x) %>%
    dplyr::mutate_if(is.numeric, signif, 3) %>%
    t() %>%
    ggpubr::ggtexttable()

  ggpubr::ggarrange(g_bar,
                    ggpubr::ggarrange(g_tab, g_desc, nrow = 2),
                    ncol = 2) %>%
    # final plot title
    ggpubr::annotate_figure(top = ggpubr::text_grob(paste("Exploration of var:",
                                                        name),
                                    color = "black", face = "bold"))
}

plot_describe.character <- function(x, name = "", max_lvl = 5, ...) {
  plot_describe(as.factor(x), name = name, max_lvl = max_lvl)
}

plot_describe.logical <- function(x, name = "", max_lvl = 5, ...) {
  plot_describe(as.factor(x), name = name, max_lvl = max_lvl)
}

plot_describe.data.frame <- function(x, max_lvl = 5, ...) {
  out <- list()

  for (n in colnames(x)) {
    out[[n]] <-plot_describe(x[[n]], name = n, max_lvl = max_lvl)
  }

  out
}