knitr::opts_chunk$set(fig.width = 12)
get_ib <- function() { ib <- openxlsx::read.xlsx('~/raw_data/olap_ib_refurb.xlsx', startRow = 4) %>% setNames(c('region', 'Family_Code', 'yyyymm', 'refurb_ind', 'installbase')) ib[1:4] %<>% lapply(zoo::na.locf) ib %<>% dplyr::mutate( Family_Code = dplyr::case_when( .$Family_Code == '350' ~ '250', .$Family_Code == 'IMMUNO SYS' ~ '3600', .$Family_Code == 'INTEGRATED SYS' ~ '5600', .$Family_Code == 'ECQ' ~ 'ECI', .$Family_Code %in% c('LABAUT', 'INSTMGR') ~ 'enGen', .$Family_Code %in% c('AUTOVUE I', 'AUTOVUE U') ~ 'AUTOVUE IU', .$Family_Code %in% c('VISION BV', 'VISION MAX BV') ~ 'VISION BV / MAX BV', .$Family_Code %in% c('VISION MTS', 'VISION MAX MTS') ~ 'VISION MTS / MAX MTS', TRUE ~ .$Family_Code ) ) %>% dplyr::filter(Family_Code %in% c('250', 'FS', 'ECI', '5600', '3600')) %>% dplyr::group_by(Family_Code, refurb_ind, yyyymm) %>% dplyr::summarise(installbase = sum(installbase)) %>% dplyr::ungroup() %>% dplyr::mutate(refurb_ind = dplyr::case_when( .$refurb_ind == 'Y' ~ 'Refurbished', .$refurb_ind == 'N' ~ 'Regular', TRUE ~ .$refurb_ind )) return(ib) } get_row_bg <- function(df) { mask <- vapply(df, is.numeric, logical(1)) cols <- t(scale(t(as.matrix(df[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)), .) return(cols) } make_row_heat_tgrob <- function(df, flex = FALSE) { cex <- ifelse(flex, .5, 1) return(df %<>% tableGrob( row = NULL, theme = ttheme_default( core = list(fg_params = list(cex = cex), bg_params = list(fill = get_row_bg(.))), colhead = list(fg_params = list(cex = cex)), rowhead = list(fg_params = list(cex = cex))) )) } 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))) return(combined) } add_title <- function(tgrob, title, flex = FALSE) { fontsize <- ifelse(flex, 8, 12) title <- textGrob(title, gp = gpar(fontsize = fontsize)) padding <- unit(5, 'mm') tgrob <- gtable::gtable_add_rows(tgrob, heights = grobHeight(title) + padding, pos = 0) tgrob <- gtable::gtable_add_grob(tgrob, title, t = 1, l = 1, r = ncol(tgrob)) return(tgrob) } cl_viz <- function(x) { count <- x %>% dplyr::group_by(Refurbished, YYYYMM) %>% dplyr::summarise(complaints = n()) norm <- x %>% dplyr::group_by(Refurbished, YYYYMM, Family_Code) %>% dplyr::summarise(complaints = n()) %>% dplyr::ungroup() %>% dplyr::left_join(y = ib, by = c('Family_Code', 'YYYYMM' = 'yyyymm', 'Refurbished' = 'refurb_ind')) %>% dplyr::mutate(complaint_rate = round(100 * complaints / installbase, 1)) %>% dplyr::select(Refurbished, YYYYMM, complaint_rate) count_tab <- count %>% tidyr::spread(YYYYMM, complaints, fill = 0) %>% make_row_heat_tgrob() %>% add_title(title = 'Complaint Count Table') normalized_tab <- norm %>% tidyr::spread(YYYYMM, complaint_rate, fill = 0) %>% make_row_heat_tgrob() %>% add_title(title = 'Complaints per 100 Analyzers Table') count_chart <- ggplot(count, aes(x = YYYYMM, y = complaints, fill = Refurbished)) + geom_col(color = 'black') + scale_fill_tableau() + labs(title = 'Complaint Count by Month', y = 'Complaints') + theme(axis.title.x = element_blank(), axis.title.y = element_text(size = 7), legend.position = 'top') norm_chart <- ggplot(norm, aes(x = YYYYMM, y = complaint_rate, group = Refurbished, color = Refurbished)) + geom_point() + geom_line(alpha = .5) + geom_text_repel(aes(label = complaint_rate), size = 3) + scale_color_tableau() + labs(title = 'Complaints per 100 Analyzers by Month', y = 'Complaints per 100 Analyzers') + theme(axis.title.x = element_blank(), axis.title.y = element_text(size = 7), legend.position = 'top') chart <- grid_arrange_shared_legend(count_chart, norm_chart, ncol = 1, nrow = 2, position = 'bottom') return(list('count_tab' = count_tab, 'normalized' = normalized_tab, 'chart' = chart)) }
raw_df <- srms::roc_eq_v26b() %>% dplyr::filter(Family_Code %in% c('250', 'FS', 'ECI', '5600', '3600'), Product_Number_T545CC != 3357) %>% dplyr::mutate( YYYYMM = as.character(YYYYMM), Refurbished = dplyr::case_when( .$Family_Code == '250' & .$Product_Number_T545CC == 3334 ~ 'Refurbished', .$Family_Code == 'FS' & .$Product_Number_T545CC == 3402 ~ 'Refurbished', .$Family_Code == 'ECI' & .$Product_Number_T545CC == 3358 ~ 'Refurbished', .$Family_Code == '5600' & .$Product_Number_T545CC == 5602 ~ 'Refurbished', .$Family_Code == '3600' & .$Product_Number_T545CC %in% c(36000267, 36000409, 36000674) ~ 'Refurbished', TRUE ~ 'Regular' ) ) ib <- get_ib() viz_list <- raw_df %>% split(.$Family_Code) %>% lapply(cl_viz)
out <- NULL for (analyzer in names(viz_list)) { out <- c( out, knitr::knit_expand( text = paste0( '\n{{analyzer}} {data-orientation=rows data-navmenu=\'Analyzer\'}', '\n=========================================', '\n\nRow {.tabset .tabset-fade}', '\n-----------------------------------------', '\n### Table', '\n```r}-tab}', '\ngrid.draw(combine(viz_list[[\'{{analyzer}}\']]$count_tab, viz_list[[\'{{analyzer}}\']]$normalized, along = 2))', '\n```', '\n\n### Chart', '\n```r}-chart}', '\ngrid.draw(viz_list[[\'{{analyzer}}\']]$chart)', '\n```' ) ) ) }
r knitr::knit(text = out)
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.