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

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

complaints <- srms_table('x600_complaints') %>% dplyr::distinct()
metrics <- srms_table('x600_program_metrics') %>% dplyr::distinct()

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))
)

summary_table <- function() {
  order <- c('module', 'Mods_Installed', 'Baseline_complaints', 'Q_complaints',
             'decrease_in_complaints', 'Baseline_complaint_rate', 
             'Q_complaint_rate', 'decrease_in_rate', 'rate_decrease_rate')

  q <- paste0(lubridate::year(last_month()),
              'Q',
              lubridate::quarter(last_month()))

  complaint_summary <- complaints %>% 
    dplyr::filter(quarter == 'Baseline' | quarter == q) %>% 
    tidyr::gather(variable, value, -(module:quarter)) %>% 
    dplyr::mutate(quarter = replace(quarter, grepl('Q', quarter), 'Q')) %>% 
    tidyr::unite(variable, quarter, variable) %>% 
    tidyr::spread(variable, value) %>% 
    dplyr::mutate(
      decrease_in_complaints = Q_complaints - Baseline_complaints, 
      decrease_in_rate = (Q_complaint_rate - Baseline_complaint_rate) %>% round(3),
      rate_decrease_rate = paste0(
        (decrease_in_rate / Baseline_complaint_rate * 100) %>% round(1),
        '%'
      ),
      Baseline_complaint_rate = Baseline_complaint_rate %>% round(3),
      Q_complaint_rate = Q_complaint_rate %>% round(3)
    )  

  metric_summary <- metrics %>% 
    dplyr::filter(quarter == max(quarter)) %>% 
    dplyr::select(module, implemented) %>% 
    dplyr::group_by(module) %>% 
    dplyr::summarise(Mods_Installed = paste(
      paste0(implemented * 100 %>% round(1), '%'),
      collapse = ' / ')
    )

  summary <- metric_summary %>%
    dplyr::left_join(
      y = complaint_summary,
      by = 'module'
    ) %>%
    .[order] 

  overall_decrease <- data.frame(
    Quarter = q,
    overall_decrease = paste0(
      (sum(summary$decrease_in_complaints) / sum(summary$Baseline_complaints) * 100) %>% round(1),
      '%'
    )
  ) %>%
    setNames(c('Quarter', 'Overall %\nVolume Reduction')) %>%
    tableGrob(row = NULL,
              theme = mytheme)

  fill <- ''
  last_row <- summary[-ncol(summary)] %>%
    add_margins() %>%
    dplyr::select(-Total) %>%
    tail(1) %>%
    dplyr::mutate_(.dots = setNames(list(~fill, ~fill, ~fill, ~fill), 
                                    names(summary)[6:ncol(summary)]))
  summary %<>% rbind(last_row)

  tgrob <- summary %>%
    setNames(c('KPI', '% All Mods\nInstalled', 'Complaint Volume\nBaseline',
               'Complaint\nVolume', 'Decrease in\nVolume', 'Normalized\nBaseline',
               'Normalized\nRate', 'Decrease in\nRate', '% Decrease\nin Rate')) %>%
    tableGrob(row = NULL,
              theme = mytheme)

  footer <- textGrob(
    '* Baseline is calculated as the quarterly average of Q42013 - Q32014',
    x = 0, hjust = 0, gp = gpar(fontsize = 8))

  tgrob <- gtable_add_rows(tgrob, heights = grobHeight(overall_decrease) + unit(1.5, 'line'))
  tgrob <- gtable_add_grob(tgrob, overall_decrease, t = nrow(tgrob), l = 3, r = 4)

  tgrob <- gtable_add_rows(tgrob, heights = grobHeight(footer) + unit(.5, 'line'))
  tgrob <- gtable_add_grob(tgrob, footer, t = nrow(tgrob), l = 1, r = ncol(tgrob))

  grid.draw(tgrob)
  invisible(tgrob)
}


grid_arrange_shared_legend <- function(
  ..., 
  ncol = length(list(...)), 
  nrow = 1, 
  position = c("bottom", "right")
) {

  plots <- list(...)
  position <- match.arg(position)
  g <- ggplotGrob(plots[[1]] + theme(legend.position = position))$grobs
  legend <- g[[which(sapply(g, function(x) x$name) == "guide-box")]]
  lheight <- sum(legend$height)
  lwidth <- sum(legend$width)
  gl <- lapply(plots, function(x) x + theme(legend.position="none"))
  gl <- c(gl, ncol = ncol, nrow = nrow)

  combined <- switch(
    position,
    "bottom" = arrangeGrob(do.call(arrangeGrob, gl),
                           legend,
                           ncol = 1,
                           heights = unit.c(unit(1, "npc") - lheight, lheight)),
    "right" = arrangeGrob(do.call(arrangeGrob, gl),
                          legend,
                          ncol = 2,
                          widths = unit.c(unit(1, "npc") - lwidth, lwidth))
  )

  grid.newpage()
  grid.draw(combined)
}

vs_baseline <- function() {

  q <- paste0(lubridate::year(last_month()),
              'Q',
              lubridate::quarter(last_month()))

  df <- complaints %>% 
    dplyr::filter(quarter == 'Baseline' | quarter == q) %>%
    dplyr::rename(Period = quarter) %>%
    dplyr::arrange(desc(module))

  volume <- ggplot(df, 
           aes(x = module, y = complaints, 
               fill = Period)) +
      geom_col(color = 'black', 
               position = 'dodge') + 
      labs(title = df$Period %>% .[grepl('Q', .)]) +
      ylab('Complaints') +
      theme(legend.position = 'top',
            axis.title.y = element_blank()) +
      scale_x_discrete(limits = rev(sort(unique(df$module)))) +
      coord_flip() +
      scale_fill_tableau()

  rate <- ggplot(df, 
           aes(x = module, y = complaint_rate, 
               fill = Period)) +
      geom_col(color = 'black', 
               position = 'dodge') + 
      ylab('Complaint Rate') +
      theme(legend.position = 'none',
            axis.title.y = element_blank()) +
      scale_x_discrete(limits = rev(sort(unique(df$module)))) +
      coord_flip() +
      scale_fill_tableau()

  grid_arrange_shared_legend(volume, rate, ncol = 1, nrow = 2, position = 'right')
  invisible(list(volume = volume, rate = rate))
}

mod_summary_plots <- function(kpi) {
  df <- complaints %>%
    dplyr::filter(module == kpi) %>%
    split(.$quarter == 'Baseline') %>%
    setNames(c('quarter', 'baseline'))

  complaint_df <- df$quarter %>% 
    dplyr::left_join(
      y = metrics %>%
        dplyr::filter(module == 'MicroSlide Incubator') %>%
        dplyr::select(mod, implemented, module, quarter), 
      by = c('module', 'quarter')
    ) %>% 
    tidyr::gather(variable, value, -c(module, quarter)) %>% 
    dplyr::filter(variable != 'installbase') %>% 
    dplyr::mutate(type = ifelse(grepl('complaint', variable), 'complaint', 'mod'))

  metric_df <- complaint_df %>% 
    dplyr::select(quarter) %>% 
    unique() %>% 
    dplyr::left_join(
      y = metrics %>%
        dplyr::filter(module == kpi), 
      by = 'quarter'
      ) %>% 
    split(is.na(.$implemented)) %>%
    setNames(c('leave', 'fill'))

  metric_df$fill %<>% 
    .[rep(seq_len(nrow(.)), each = length(unique(metric_df$leave$mod))), ]

  metric_df$fill$mod <- unique(metric_df$leave$mod)
  metric_df$fill$implemented <- 0

  metric_df %<>% dplyr::bind_rows()

  complaint_plot <- ggplot(
    complaint_df %>% 
      dplyr::filter(type == 'complaint') %>%
      dplyr::mutate(value = as.numeric(value)),
    aes(x = quarter, y = value)
  ) +
    geom_point() +
    geom_text(aes(label = round(value, 2)),
              vjust = 'inward', hjust = 'inward') +
    geom_line(group = 1, alpha = .5) +
    geom_vline(
      data = metric_df %>%
        dplyr::group_by(mod) %>%
        dplyr::summarise(quarter = max(quarter[implemented == 0])),
      aes(xintercept = match(quarter, unique(complaint_df$quarter)),
          color = mod)
    ) + 
    facet_wrap(~variable, ncol = 1, scale = 'free_y') +
    theme(axis.title.x = element_blank(),
          legend.position = 'none') +
    scale_color_tableau() 

  mod_plot <- ggplot(
    metric_df,
    aes(x = quarter, y = implemented,
        color = mod, group = mod)) +
    geom_point() +
    geom_text(
      data = metrics %>%
        dplyr::filter(module == kpi,
                      implemented > 0,
                      implemented < 1),
      aes(x = quarter, y = implemented, color = mod,
          label = paste0(implemented * 100 %>% round(1), '%')),
      vjust = 'inward', hjust = 'inward'
    ) +
    geom_line(alpha = .5) +
    ylab('% Installed') +
    scale_color_tableau() +
    theme(legend.title = element_blank(),
          axis.title.x = element_blank(),
          legend.justification = c(0, 0),
          legend.position = c(.1, .75))

  cost_so_plot <- ggplot(
    metric_df %>% 
      dplyr::select(-HL.Calls, -Hours, - Parts, -mod, -implemented) %>% 
      tidyr::gather(variable, value, c(-quarter, -module)),
    aes(x = quarter, y = value)
  ) + 
    geom_point() + 
    geom_text(
      aes(label = ifelse(variable == 'Cost', 
                         paste0('$', round(value, 2)), 
                         round(value, 2))),
      vjust = 'inward', hjust = 'inward'
    ) + 
    geom_line(aes(group = 1), alpha = .5) + 
    geom_vline(
      data = metric_df %>%
        dplyr::group_by(mod) %>%
        dplyr::summarise(quarter = max(quarter[implemented == 0])),
      aes(xintercept = match(quarter, unique(complaint_df$quarter)),
          color = mod)
    ) +
    facet_wrap(~variable, ncol = 1, scale = 'free_y') +
    theme(axis.title.x = element_blank(),
          legend.position = 'none') +
    scale_color_tableau()

  return(list(complaint_plot = complaint_plot,
              mod_plot = mod_plot,
              cost_so_plot = cost_so_plot))
}

x600 Summary {data-orientation=columns}

Column {.tabset .tabset-fade}

x600 Overall Summary

summary_table()

Past Quarter vs. Baseline

vs_baseline()

out <- NULL
kpis <- c('MicroSlide Incubator', 'MicroWell Wash - Volume',
          'MicroWell Incubator', 'MicroSlide Insert Blades',
          'Compressor', 'SB5-010 System Timeouts', 'MicroWell Wash - Thermal')
for (kpi in kpis) {
  out <- c(
    out,
    knitr::knit_expand(
      text = paste0(
        '\n{{kpi}} {data-orientation=rows data-navmenu=\'KPI\'}',
        '\n=====================================',
        '\n\nRow',
        '\n-------------------------------------',
        '\n\n### {{kpi}} : % Mods Installed',
        '\n```r}-mods}',
        '\nx <- mod_summary_plots(kpi = \'{{kpi}}\')',
        '\nprint(x$mod_plot)',
        '\n```',
        '\n\nRow {.tabset .tabset-fade}',
        '\n-------------------------------------',
        '\n\n### {{kpi}} : Complaint Summary',
        '\n```r}-complaints}',
        '\nprint(x$complaint_plot)',
        '\n```',
        '\n\n### {{kpi}} : Cost / Service Metrics',
        '\n```r}-cost-service}',
        '\nprint(x$cost_so_plot)',
        '\n```'
      ),
      kpi = kpi
    )
  )
}