In kimjam/srms: Package to automate tasks and reporting for OCD SRMS Team.

knitr::opts_chunk$set(fig.width = 12)

mytheme <- gridExtra::ttheme_default(
  core = list(fg_params=list(cex = .5)),
  colhead = list(fg_params=list(cex = .5)),
  rowhead = list(fg_params=list(cex = .5))
)

get_row_bg <- function(df) {
  rowtotal <- 'Total' %in% names(df)
  if (rowtotal) x <- df %>% dplyr::select(-Total)
  mask <- vapply(x, is.numeric, logical(1))
  cols <- t(scale(t(as.matrix(x[mask])))) %>%
  apply(., 
        1, 
        function(x)
          dplyr::case_when(
            x < -2 ~ '#198c19',
            dplyr::between(x, -2, -1.5) ~ '#4ca64c',
            dplyr::between(x, -1.5, -1) ~ '#7fbf7f',
            dplyr::between(x, -1, -.5) ~ '#b2d8b2',
            dplyr::between(x, -.5, 0) ~ '#e5f2e5',
            dplyr::between(x, 0, .5) ~ '#ffe5e5',
            dplyr::between(x, .5, 1) ~ '#ffb2b2',
            dplyr::between(x, 1, 1.5) ~ '#ff7f7f',
            dplyr::between(x, 1.5, 2) ~ '#ff4c4c',
            x > 2 ~ '#ff1919',
            TRUE ~ 'black'
          )) %>% 
  t() %>%
  cbind(matrix(rep('grey', sum(!mask) * nrow(.)), ncol = sum(!mask)), .)

  if (rowtotal) {
    cols %<>% cbind(matrix(rep('grey', nrow(.)), ncol = 1))
  }

  return(cols)
}

row_heat_table <- . %>%
  tableGrob(
    row = NULL,
    theme = ttheme_default(
      core = list(fg_params = list(cex = .5),
                  bg_params = list(fill = get_row_bg(.))),
      colhead = list(fg_params = list(cex = .5)),
      rowhead = list(fg_params = list(cex = .5)))
  )

grob_binder <- function(ggrob, tgrob) {
  tgrob$heights <- unit.pmax(tgrob$heights)#, unit(2, 'lines'))
  tgrob$widths <- unit(rep(1/ncol(tgrob), ncol(tgrob)), 'npc')

  ggrob %<>% gtable_add_rows(., sum(tgrob$heights))
  ggrob %<>% gtable_add_grob(., grobs = tgrob, t = nrow(ggrob),
                             l = 4, b = nrow(ggrob), r = 4)

  grid.draw(ggrob)
  invisible(ggrob)
}

ggpareto <- function(
  df,
  filter,
  title
) {

  df %<>%
    df_checker() %>%
    dplyr::filter_(
      filter
    )

  xlabel <- 'Call Area'
  ylabel <- 'Count of Complaints'

  x <- na.omit(df[, 'Call_Area']) %>%
    dplyr::rename(modality = Call_Area)

  Df <- x %>%
    dplyr::group_by(
      modality
    ) %>%
    dplyr::summarise(
      frequency = n()
    ) %>%
    dplyr::arrange(
      -frequency
    )

  Df$modality <- ordered(
    Df$modality,
    levels = unlist(Df$modality, use.names = FALSE)
  )

  Df %<>%
    dplyr::mutate(
      modality_int = as.integer(modality),
      cumfreq = cumsum(frequency),
      cumperc = cumfreq / nrow(x) * 100
    )

  nr <- nrow(Df)
  N <- sum(Df$frequency)

  Df_ticks <- data.frame(xtick0 = rep(nr +.55, 11),
                         xtick1 = rep(nr +.59, 11),
                         ytick = seq(0, N, N/10))

  y2 <- c('  0%', ' 10%', ' 20%', ' 30%', ' 40%', ' 50%',
          ' 60%', ' 70%', ' 80%', ' 90%', ' 100%')

  g <- ggplot(
    Df,
    aes(x = modality, y = frequency)
  ) +
    geom_bar(
      stat='identity',
      aes(fill='red')
    ) +
    geom_text(
      aes(x= modality, y = 0, label = frequency, vjust = -1),
      size = 2.5
    ) +
    geom_line(
      aes(x = modality_int, y = cumfreq)
    ) +
    geom_point(
      aes(x = modality_int, y = cumfreq),
      pch = 19
    ) +
    geom_text(
      aes(
        x = modality_int,
        y = cumfreq,
        label = paste0(round(cumperc, digits = 1), '%')
      ),
      vjust = -1,
      size = 2.5
    ) +
    scale_y_continuous(
      breaks = seq(0, N, N/10),
      limits = c(-.02 * N, N * 1.02),
      labels = round(seq(0, N, N/10))
    ) +
    scale_x_discrete(
      breaks = Df$modality
    ) +
    guides(
      fill = FALSE, color = FALSE
    ) +
    annotate(
      "rect", xmin = nr + .55, xmax = nr + 1,
      ymin = -.02 * N, ymax = N * 1.02, fill = 'white'
    ) +
    annotate(
      "text", x = nr + .8, y = seq(0, N, N/10),
      label = y2, size = 1.5
    ) +
    geom_segment(
      x = nr + .55, xend = nr + .55, y = -.02 * N,
      yend = N * 1.02, color = 'grey50'
    ) +
    geom_segment(
      data = Df_ticks,
      aes(x = xtick0, y = ytick, xend = xtick1, yend = ytick)
    ) +
    geom_segment(
      aes(
        x = .5,
        xend = nr+.5,
        y = seq(0, N, N/10)[9],
        yend = seq(0, N, N/10)[9],
        color = 'red'
      )
    ) +
    labs(
      title = paste0('Pareto Chart of ', title),
      y = ylabel,
      x = xlabel
    ) +
    theme_bw() +
    theme(
      axis.text.x = element_text(angle = 90, size = 7, vjust = .5, hjust = 1),
      axis.text.y = element_text(size = 7),
      title = element_text(size = 7)
    )

  return(list(data = Df, plot = g))
}

path <- file.path('~', 'reporting', 'monthly', 'EFS', lubridate::year(last_month()),
                  strftime(last_month(), format = '%m-%b'))
file <- dir(path) %>% .[grepl('raw', tolower(.))]
df <- readxl::read_excel(file.path('~', 'reporting', 'monthly', 'EFS',
                                   lubridate::year(last_month()),
                                   strftime(last_month(), format = '%m-%b'),
                                   file)) %>%
  df_checker() %>%
  dplyr::mutate(YYYYMM = as.character(YYYYMM))

EFS Monthly Trending

ggrob <- ggplotGrob(
  ggplot(df %>% dplyr::count(YYYYMM),
         aes(x = YYYYMM, y = n)) +
    geom_point() +
    geom_text_repel(aes(label = n)) +
    geom_line(group = 1) +
    ylab('Complaints') + xlab('Month') + ggtitle('Complaints per Month')
)

tgrob <- df %>%
  dplyr::count(Call_Subject, Call_Subject_Desc, YYYYMM) %>%
  tidyr::spread(YYYYMM, n, fill = 0) %>%
  setNames(c('Call Subject', 'Call Subject Desc', 
             strftime(as.Date(paste0(sort(unique(df$YYYYMM)), '01'), 
                              format = '%Y%m%d'), format = '%b-%Y'))) %>%
  add_margins() %>%
  row_heat_table()

supptab <- data.frame(
  Info = c('3 Month Average', '2017 Total'), 
  Complaints = c(mean(df %>% 
                        dplyr::count(YYYYMM) %>% 
                        .$n %>% 
                        tail(3)), 
                 sum(df %>% 
                       dplyr::count(year) %>% 
                       dplyr::filter(year == lubridate::year(last_month())) %>% 
                       .$n)),
  stringsAsFactors = FALSE) 
tgrob %<>% combine(., supptab %>% tableGrob(row = NULL, theme = mytheme), 
                   along = 1)
tgrob$heights <- unit.pmax(tgrob$heights)

ggrob %<>% gtable_add_rows(., sum(tgrob$heights))
ggrob %<>% gtable_add_grob(., grobs = tgrob, t = nrow(ggrob),
                           l = 4, b = nrow(ggrob), r = 4)

grid.draw(ggrob)

EFS Complaints by Country

countries <- srms::srms_table('country_codes')
df %>%
  dplyr::count(Country_Code, YYYYMM) %>%
  dplyr::ungroup() %>%
  tidyr::spread(YYYYMM, n, fill = 0) %>%
  dplyr::left_join(y = countries %>% dplyr::select(-Region),
                   by = 'Country_Code') %>%
  dplyr::select(-Country_Code) %>%
  dplyr::select(colNums = c(ncol(.), 1:(ncol(.) - 1))) %>%
  setNames(c('Country', 
             strftime(as.Date(paste0(sort(unique(df$YYYYMM)), '01'), 
                              format = '%Y%m%d'), format = '%b-%Y'))) %>%
  add_margins() %>%
  row_heat_table() %>%
  combine(., tail(supptab, 1) %>% tableGrob(row = NULL, theme = mytheme), 
          along = 1) %>%
  grid.draw()

tables <- df %>% 
  dplyr::filter(YYYYMM == max(YYYYMM)) %>%
  dplyr::count(Call_Subject, Call_Subject_Desc, Call_Area) %>%
  dplyr::rename(Complaints = n) %>%
  split(.$Call_Subject_Desc)

raw_dfs <- df %>% 
  dplyr::filter(YYYYMM == max(YYYYMM)) %>%
  split(.$Call_Subject_Desc)

out <- NULL
for (csd in names(tables)) {
  out <- c(
    out,
    knitr::knit_expand(
      text = paste0(
        '\n{{csd}} {data-navmenu=\'Call Subject\'}',
        '\n=====================================',
        '\n```r}, fig.width = 10}',
        '\npareto <- ggpareto(df = raw_dfs[[\'{{csd}}\']], filter = \'TRUE\', title = \'{{csd}}\')',
        '\ngrob_binder(ggrob = ggplotGrob(pareto$plot), tgrob = tables[[\'{{csd}}\']] %>% tableGrob(row = NULL, theme = mytheme))',
        '\n```'
      ),
      count = match(csd, names(tables)),
      csd = csd
    )
  )
}

r knitr::knit(text = out)

Resolution by Month {data-navmenu='Resolutions'}

Column {.tabset .tabset-fade}

Resolutions by Month Plot

table <- df %>%
  dplyr::count(YYYYMM, Resolution) %>%
  tidyr::spread(YYYYMM, n, fill = 0) %>%
  tidyr::gather(YYYYMM, n, -Resolution)

ggrob <- ggplotGrob(
  ggplot(table,
         aes(x = YYYYMM, y = n,
             fill = Resolution)) +
    geom_col(color = 'black') +
    xlab('Month') + ylab('Complaints') + ggtitle('Resolutions by Month')
)

tgrob <- table %>%
  tidyr::spread(YYYYMM, n, fill = 0) %>%
  setNames(c('Resolution', 
             strftime(as.Date(paste0(sort(unique(df$YYYYMM)), '01'), 
                              format = '%Y%m%d'), format = '%b-%Y'))) %>%
  add_margins() %>%
  row_heat_table() %>%
  combine(., tail(supptab, 1) %>% tableGrob(row = NULL, theme = mytheme), 
          along = 1)

grid.draw(ggrob)

Resolutions by Month Table

grid.draw(tgrob)

`r paste0('Resolutions in ', strftime(last_month(), format = '%B - %Y'))` {data-navmenu='Resolutions'}

df %>%
  dplyr::filter(YYYYMM == max(YYYYMM)) %>%
  dplyr::count(Resolution) %>%
  dplyr::filter(n > 0) %>%
  dplyr::mutate(Resolution = replace(Resolution, is.na(Resolution), 'NA')) %>%
  ggplot(aes(x = reorder(Resolution, -n), y = n)) +
  geom_col(fill = 'white', color = 'black') +
  geom_text(aes(label = n), vjust = 1) +
  xlab('Resolution') + ylab('Complaints') + 
  ggtitle(paste0('Complaints by Resolution in ',
                 strftime(last_month(), format = '%B-%Y')))

Lots

df %>%
  dplyr::filter(YYYYMM == max(YYYYMM)) %>%
  dplyr::count(Lot_Serial_Number) %>%
  dplyr::filter(n > 0) %>%
  ggplot(aes(x = reorder(Lot_Serial_Number, -n), y = n)) +
  geom_col(fill = 'white', color = 'black') +
  geom_text(aes(label = n), vjust = 1) +
  xlab('Lot Number') + ylab('Complaints') + 
  ggtitle(paste0('Complaints by Lot Number in ',
                 strftime(last_month(), format = '%B-%Y')))