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)) }
summary_table()
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 ) ) }
r knitr::knit(text = out)
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.