R/ggimportance.R

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

#' Generate a ggplot2 for rank versus relative importance chart.
#'
#' The function generates a scatter plot of item rank (y-axis) versus importance (x-axis)
#'
#' The function uses the `relaimpo` package to compute item importance (relative to a dependent variable)
#' Then, it plots the item's rank versus computed importance.
#' To compute importance the function uses the `lmg` measure (see documentation of `relaimpo::calc.relimp`)
#' A linear model (function `lm`) is used for the importance computation. if the model have perfect fit
#' or a bad fit, the function output would be based only on the model coefficients and not on `relaimpo::calc.relimp`
#'
#' @param x a tbl() with the data.
#' @param dep_var The name of the dependent variable (use dplyr style without quotes)
#'     Usually this would be either general satisfaction or NPS
#' @param title string for ggtitle
#' @param xlabel string for xlab
#' @param ylabel string for ylab
#'
#' @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
#'   )
#' ggimportance(satisfaction, dep_var = general)
#'
#' @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 rlang !!
#' @export



ggimportance <- function(x,dep_var = "general",title="",
                            xlabel="Relative contribution to dependent variable",
                            ylabel="Mean rank (1-5)"){


  dep_var_str <- rlang::as_string(rlang::ensym(dep_var))
  dep_var_unquoted <- rlang::enquo(dep_var)

  model_formula <- as.formula(
    paste0(dep_var_str, "~ ."))

  model <- lm(formula = model_formula, data = x)


  #check for bad model
  if (!(is.na(sum(model$coefficients)) | summary(model)$r.squared==1)) {
    #good model:
    relaimportance <- relaimpo::calc.relimp(model)

    importance_tib <- tibble(item = names(relaimportance$lmg),
                             Importance = relaimportance$lmg)


    x %>% select(-!!dep_var_unquoted) %>% gather(item, value) %>%
      filter(!is.na(value)) %>% group_by(item) %>% summarize(mean_rank = mean(value)) %>%
      left_join(importance_tib) %>% ggplot(aes(x = Importance,
                                               y = mean_rank, fill = item)) + geom_point(size = 3) +
      ggrepel::geom_label_repel(aes(label = item)) + theme_bw() +
      xlab(xlabel) +
      ylab(ylabel) +
      ggtitle(title)+
      scale_x_continuous(labels = scales::percent_format(1)) +
      guides(fill = F)



  } else {


    #bad model:

    s <- summary(model)
    item <- row.names(s$coefficients)
    coff <- s$coefficients[,1]
    p <- s$coefficients[,4]
    coff_table <- tibble(item,coff,p) %>%
      mutate(importance=abs(coff)) %>%
      select(item,importance)

    x %>% select(-!!dep_var_unquoted) %>%
      gather(item, value) %>%
      filter(!is.na(value)) %>%
      group_by(item) %>%
      summarize(mean_rank = mean(value)) %>%
      left_join(coff_table,by=c("item")) %>%
      mutate(Importance=ifelse(is.na(importance),0,importance)) %>%
      mutate(Importance=Importance/sum(Importance)) %>%
      ggplot(aes(x = Importance,
                     y = mean_rank, fill = item)) + geom_point(size = 3) +
      labs(subtitle = "importance based on coefficients, perfect fit" )+
      ggrepel::geom_label_repel(aes(label = item)) + theme_bw() +
      xlab(xlabel) +
      ylab(ylabel) +
      ggtitle(title)+
      scale_x_continuous(labels = scales::percent_format(1)) +
      guides(fill = F)

  }

}