R/gglikert.R

In sarid-ins/saridr: An R package for common tasks related to market research analysis via R

#' Generate a ggplot2 for a likert 5-scale question.
#'
#' The function generates a bar chart with fill colors determined by likert 5-point scale.
#' The chart includes labels with the proportion, labels with averages (1-5) on top of bars, and
#' the fill is red-yellow-green colored.
#'
#' The function uses the raw data in a tabular format (each column is a variable).
#' NAs as omitted.
#'
#' Assumes that the columns are numeric with values 1-5.
#'
#' @param x a tbl() with the data.
#' @param axis.x.wrap The x.axis text wrap.
#' @param wrap_RTL If T, uses unicode characters to have the text wrap
#'       fitted for RTL languages (e.g., Hebrew and Arabic).
#'       This parameter is also required to preserve UTF-8 encoding when using Hebrew.
#' @param likert_scale_labels The labels for the likert scale. The default is a 5-point likert scale with
#'       "1 - Extremely Dissatisfied", 2:4, "5 - Extremely Satisfied".
#' @param likert_scale_fill Provide scale to be used. Makes colors consistent, even if some levels
#'       Are missing from data. Defaults to brewer "RdYlGn".
#' @param likert_scale_numeric Controls the numeric values related to the likert, for example, can be modified
#'       to a 1-7 likert scale by using 1:7 along with the proper updates to the likert_scale_labels
#' @return A ggplot2 as specified above.
#'
#' @examples
#' satisfaction <- tribble(
#'   ~general, ~staff, ~professionalism,
#'   5, 5, 4,
#'   3, 2, 3,
#'   4, 5, 5,
#'   1, 2, 2,
#'   3, 3, 4
#'   )
#' gglikert(satisfaction)
#'
#' # You may also define your own text for the legend
#'
#' gglikert(satisfaction, likert_scale_labels = c("not at all", "low", "somewhat", "very", "extremely"))
#'
#' @importFrom magrittr %>%
#' @importFrom ggplot2 ggplot
#' @importFrom ggplot2 aes
#' @importFrom ggplot2 geom_col
#' @importFrom ggplot2 scale_fill_brewer
#' @importFrom ggplot2 geom_label
#' @importFrom ggplot2 geom_text
#' @importFrom ggplot2 guides
#' @importFrom ggplot2 guide_legend
#' @importFrom ggplot2 theme_bw
#' @importFrom ggplot2 xlab
#' @importFrom ggplot2 ylab
#' @importFrom dplyr select
#' @importFrom dplyr ends_with
#' @importFrom dplyr group_by
#' @importFrom dplyr ungroup
#' @importFrom dplyr mutate
#' @importFrom dplyr arrange
#' @importFrom dplyr desc
#' @importFrom dplyr summarize
#' @importFrom dplyr filter
#' @importFrom tidyr gather
#' @importFrom stringr str_wrap
#' @importFrom RColorBrewer brewer.pal
#'
#' @export
gglikert <- function(x, axis.x.wrap = 12, wrap_RTL = F,
                     likert_scale_labels = c("1 - Extremely\nDissatisfied", 2:4, "5 - Extremely\nSatisfied"),
                     likert_scale_fill = "RdYlGn",
                     likert_scale_numeric = 1:5){

  if (is.null(wrap_RTL)){
    special_wrap <- function(string, ...){string}
  } else if (wrap_RTL){
    special_wrap <- str_wrap_RTL
  } else {
    special_wrap <- str_wrap
  }

  # set consistent colors by brewer
  consistent_colors <- brewer.pal(n = length(likert_scale_labels),
                                  name = likert_scale_fill) %>%
    set_names(likert_scale_numeric)

  distribution_tib <- x %>%
    gather(item, value) %>%
    filter(!is.na(value)) %>%
    filter(saridr::notin(value, c(99, -99))) %>%
    group_by(item) %>%
    saridr::prop(value, leave_n = T) %>%
    ungroup %>%
    mutate(item = special_wrap(string = item, width = axis.x.wrap)) %>%
    group_by(item) %>%
    mutate(mean = sum(prop*value)) %>%
    arrange(desc(mean)) %>%
    ungroup %>%
    mutate(item = fct_inorder(item))

  means_tib <- distribution_tib %>%
    group_by(item, mean) %>%
    summarize(sample_size = sum(n4prop)) %>%
    mutate(mean_lbl = paste0("Avg. ", round(mean, 2)))

  label_tib <- distribution_tib %>%
    arrange(item, desc(value)) %>%
    group_by(item) %>%
    mutate(prop_lbl = paste0(round(prop*100), "% (", n4prop, ")")) %>%
    filter(prop >= 0.05) %>%
    mutate(prop = cumsum(prop))

  ggplot(distribution_tib,
         aes(x = item, y = prop, fill = factor(value))) +
    geom_col(color = "black") +
    scale_fill_manual(values = consistent_colors,
                      breaks = likert_scale_numeric,
                      labels = likert_scale_labels) +
    geom_text(data = label_tib,
              aes(label = prop_lbl), nudge_y = -0.03, nudge_x = -0.4,
              hjust = 0) +
    guides(fill = guide_legend("Satisfaction")) +
    theme_bw() +
    scale_y_continuous(labels = scales::percent_format(1), breaks = seq(0, 1, 0.2)) +
    xlab("") +
    ylab("Proportion") +
    geom_label(data = means_tib, aes(y = 1.1, x = item, label = mean_lbl),
               inherit.aes = F, fill = "white")
}