knitr::opts_chunk$set(fig.width = 8)
join_region <- . %>% dplyr::left_join(y = countries %>% dplyr::select(Region, Country_Code), by = 'Country_Code') %>% dplyr::mutate( Region = dplyr::case_when( .$Country_Code == 'CA' ~ 'CANADA', .$Country_Code == 'CH' ~ 'CHINA', .$Country_Code == 'JP' ~ 'JAPAN', .$Country_Code == 'IN' ~ 'INDIA', TRUE ~ .$Region ) ) %>% split(.$Region) 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) { 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) } 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) } make_basic_table <- function(df) { DT::datatable(data = df, options = list(dom = 'ft', scrollY = '300px', paging = FALSE), rownames = FALSE, colnames = gsub('\\.|_' ,' ', names(df)), escape = TRUE) } region_summary <- function(region) { if (region == 'GLOBAL') { tablist <- list(CLRE = clre %>% dplyr::bind_rows(), CLEQ = cleq %>% dplyr::bind_rows(), TMRE = tmre %>% dplyr::bind_rows(), TMEQ = tmeq %>% dplyr::bind_rows()) } else { tablist <- list(CLRE = clre[[region]], CLEQ = cleq[[region]], TMRE = tmre[[region]], TMEQ = tmeq[[region]]) } grouper <- function(df) { grouped <- data.frame( YYYYMM = strftime(c(Sys.time()-months(13:2), last_month()), format = '%Y%m'), stringsAsFactors = FALSE ) %>% dplyr::left_join( y = df %>% dplyr::group_by(YYYYMM) %>% dplyr::summarise(complaints = n()), by = 'YYYYMM' ) %>% dplyr::mutate(complaints = replace(complaints, is.na(complaints), 0)) return(grouped) } df <- lapply(tablist, grouper) %>% dplyr::bind_rows() %>% dplyr::mutate(Type = rep(names(tablist), each = 13), complaints = replace(complaints, is.na(complaints), 0)) df_wide <- df %>% tidyr::spread(key = YYYYMM, value = complaints, fill = 0) %>% srms::add_margins() %>% dplyr::select(-Total) %>% row_heat_table() plot <- ggplotGrob( ggplot(df, aes(x = YYYYMM, y = complaints, group = Type, color = Type)) + geom_point() + # geom_text(aes(label = complaints), # size = 3, # hjust = 'inward', vjust = 'inward') + geom_line() + labs(title = paste(region, 'Complaint Summary')) + theme(legend.position = 'top', axis.title.x = element_blank(), legend.text = element_text(size = 7), text = element_text(size = 8)) + scale_color_tableau() ) grob_binder(ggrob = plot, tgrob = df_wide) } clre_summary <- function(region) { if (region == 'GLOBAL') { df <- clre %>% dplyr::bind_rows() %>% srms::add_clre_tech(write = FALSE) } else { df <- clre[[region]] %>% srms::add_clre_tech(write = FALSE) } bycs <- df %>% dplyr::filter(YYYYMM == max(YYYYMM)) %>% dplyr::group_by(Call_Subject) %>% dplyr::summarise(complaints = n()) %>% dplyr::arrange(-complaints) %>% dplyr::mutate(Cumulative_Percent_of_Total = round(cumsum( complaints / sum(complaints) * 100), 1)) bytech <- df %>% dplyr::group_by(Technology, YYYYMM) %>% dplyr::summarise(complaints = n()) %>% tidyr::spread(key = YYYYMM, value = complaints, fill = 0) %>% srms::add_margins() %>% dplyr::select(-Total) %>% tidyr::gather(key = YYYYMM, value = complaints, -Technology) df_wide <- bytech %>% tidyr::spread(key = YYYYMM, value = complaints, fill = 0) %>% row_heat_table() plot <- ggplotGrob( ggplot(bytech, aes(x = YYYYMM, y = complaints, group = Technology, color = Technology)) + geom_point() + # geom_text(aes(label = complaints), # size = 3, # hjust = 'inward', vjust = 'inward') + geom_line() + labs(title = paste(region, 'CLRE Complaints by Technology')) + theme(legend.position = 'top', axis.title.x = element_blank(), legend.text = element_text(size = 7), text = element_text(size = 8)) + scale_color_tableau() ) return(list(bycs = bycs, bytechtab = df_wide, bytechplot = plot)) } cleq_summary <- function(region) { if (region == 'GLOBAL') { df <- cleq %>% dplyr::bind_rows() %>% dplyr::mutate(Region = 'GLOBAL') } else { df <- cleq[[region]] } df %<>% dplyr::rename(Analyzer = Family_Code) %>% dplyr::left_join( y = ib, by = c('Region' = 'region', 'YYYYMM' = 'yyyymm', 'Analyzer' = 'analyzer') ) %>% dplyr::group_by(Analyzer, YYYYMM) %>% dplyr::summarise(complaints = n(), ib = mean(installbase), normalized = round(complaints / ib, 2)) %>% dplyr::arrange(-complaints) count_wide <- df %>% dplyr::select(-ib, -normalized) %>% tidyr::spread(key = YYYYMM, value = complaints, fill = 0) %>% srms::add_margins() %>% dplyr::select(-Total) %>% row_heat_table() normalized_wide <- df %>% dplyr::filter(!is.na(normalized)) %>% dplyr::select(-ib, -complaints) %>% tidyr::spread(key = YYYYMM, value = normalized, fill = 0) %>% row_heat_table() count_plot <- ggplotGrob( ggplot(df %>% dplyr::select(-ib, -normalized) %>% tidyr::spread(key = YYYYMM, value = complaints, fill = 0) %>% tidyr::gather(key = YYYYMM, value = complaints, -Analyzer), aes(x = YYYYMM, y = complaints, group = Analyzer, color = Analyzer)) + geom_point() + # geom_text(aes(label = complaints), # hjust = 'inward', vjust = 'inward') + geom_line() + labs(title = paste(region, 'CLEQ Complaints by Analyzer')) + theme(legend.position = 'top', axis.title.x = element_blank(), legend.text = element_text(size = 5), text = element_text(size = 5)) + scale_color_tableau() ) normalized_plot <- ggplotGrob( ggplot(df %>% dplyr::filter(!is.na(normalized)) %>% dplyr::select(-ib, -complaints) %>% tidyr::spread(key = YYYYMM, value = normalized, fill = 0) %>% tidyr::gather(key = YYYYMM, value = normalized, -Analyzer), aes(x = YYYYMM, y = normalized, group = Analyzer, color = Analyzer)) + geom_point() + # geom_text(aes(label = normalized), # hjust = 'inward', vjust = 'inward') + geom_line() + labs(title = paste(region, 'CLEQ Normalized Complaints by Analyzer')) + theme(legend.position = 'top', axis.title.x = element_blank(), legend.text = element_text(size = 5), text = element_text(size = 5)) + scale_color_tableau() ) return(list(counttab = count_wide, normtab = normalized_wide, countplot = count_plot, normplot = normalized_plot)) } tmre_summary <- function(region) { if (region == 'GLOBAL') { x <- tmre %>% dplyr::bind_rows() } else { x <- tmre[[region]] } df <- x %>% dplyr::mutate( Group = dplyr::case_when( grepl('MT', .$Call_Subject) ~ 'MTS Reagent', .$Business_Unit_Desc == 'BLOOD SCREENING' ~ 'DONOR\nSCREENING', .$Business_Unit_Desc == 'IMMUNOHEMATOLOGY' ~ 'IH', TRUE ~ .$Business_Unit_Desc ) ) %<>% dplyr::group_by( Group, YYYYMM ) %>% dplyr::summarise(complaints = n()) tgrob <- data.frame( YYYYMM = strftime(c(Sys.time()-months(13:2), last_month()), format = '%Y%m'), Group = rep(unique(df$Group), each = 13), stringsAsFactors = FALSE ) %>% dplyr::left_join(y = df, by = c('YYYYMM', 'Group')) %>% tidyr::spread(key = YYYYMM, value = complaints, fill = 0) df <- tgrob %>% tidyr::gather(key = YYYYMM, value = complaints, -Group) tgrob %<>% srms::add_margins() %>% dplyr::select(-Total) %>% row_heat_table() ggrob <- ggplotGrob( ggplot(df, aes(x = YYYYMM, y = complaints, color = Group, group = Group)) + geom_point() + geom_line() + labs(title = paste(region, 'TMRE Complaints by Group')) + theme(legend.position = 'top', axis.title.x = element_blank(), legend.text = element_text(size = 7), text = element_text(size = 8)) + scale_color_tableau() ) bycs <- x %>% dplyr::filter(YYYYMM == max(YYYYMM)) %>% dplyr::group_by(Call_Subject_Desc) %>% dplyr::summarise(complaints = n()) %>% dplyr::arrange(-complaints) %>% dplyr::mutate(Cumulative_Percent_of_Total = round(cumsum( complaints / sum(complaints) * 100), 1)) return(list(bycs = bycs, t = tgrob, g = ggrob)) } tmeq_summary <- function(region) { if (region == 'GLOBAL') { x <- tmeq %>% dplyr::bind_rows() } else { x <- tmeq[[region]] } df <- data.frame( YYYYMM = strftime(c(Sys.time()-months(13:2), last_month()), format = '%Y%m'), stringsAsFactors = FALSE ) %>% dplyr::left_join( y = x %>% dplyr::group_by(Analyzer, YYYYMM) %>% dplyr::summarise(complaints = n()), by = c('YYYYMM') ) counttab <- df %>% tidyr::spread(key = YYYYMM, value = complaints, fill = 0) %>% split(.$Analyzer == 'Other') %>% dplyr::bind_rows() %>% srms::add_margins() %>% dplyr::select(-Total) %>% dplyr::mutate(Analyzer = replace(Analyzer, Analyzer == 'VISION MAX BV', 'VISION MAX\nBV')) %>% row_heat_table() countplot <- ggplotGrob( ggplot(df %>% tidyr::spread(key = YYYYMM, value = complaints, fill = 0) %>% tidyr::gather(key = YYYYMM, value = complaints, -Analyzer), aes(x = YYYYMM, y = complaints, color = Analyzer, group = Analyzer)) + geom_point() + geom_line() + labs(title = paste(region, 'TMEQ Complaints by Analyzer')) + theme(legend.position = 'top', axis.title.x = element_blank(), legend.text = element_text(size = 7), text = element_text(size = 8)) + scale_color_tableau() ) normdf <- df %>% dplyr::filter(Analyzer != 'Other') %>% dplyr::mutate(Region = region) %>% dplyr::left_join( y = ib, by = c('Region' = 'region', 'YYYYMM' = 'yyyymm', 'Analyzer' = 'analyzer') ) %>% dplyr::mutate(normalized = round(complaints / installbase, 2)) %>% dplyr::select(-Region, -installbase, - complaints) %>% dplyr::filter(!is.na(normalized)) normtab <- normdf %>% tidyr::spread(key = YYYYMM, value = normalized, fill = 0) %>% dplyr::mutate(Analyzer = replace(Analyzer, Analyzer == 'VISION MAX BV', 'VISION MAX\nBV')) %>% row_heat_table() normplot <- ggplotGrob( ggplot(normdf, aes(x = YYYYMM, y = normalized, group = Analyzer, color = Analyzer)) + geom_point() + geom_line() + labs(title = paste(region, 'TMEQ Normalized Complaints')) + theme(legend.position = 'top', axis.title.x = element_blank(), legend.text = element_text(size = 7), text = element_text(size = 8)) + scale_color_tableau() ) return(list(counttab = counttab, countplot = countplot, normtab = normtab, normplot = normplot)) }
countries <- srms::srms_table('country_codes') clre <- srms::roc_re_v26b(add = 'country') %>% dplyr::filter(YYYYMM %in% head(sort(unique(YYYYMM)), 13)) %>% dplyr::mutate(YYYYMM = as.character(YYYYMM)) %>% join_region() cleq <- srms::roc_eq_v26b(add = 'country') %>% dplyr::filter(YYYYMM %in% head(sort(unique(YYYYMM)), 13)) %>% dplyr::mutate(YYYYMM = as.character(YYYYMM)) %>% join_region() tm <- srms::tm_general_template() %>% dplyr::filter(Call_Subject != 'NONPROD') %>% dplyr::mutate(YYYYMM = strftime(Create_Audit_DT, format = '%Y%m'), Type = ifelse(Call_Type %in% c('CE', 'PHSE', 'CERE', 'CSW'), 'Instrument', 'Reagent' ) ) %>% dplyr::filter(YYYYMM %in% head(sort(unique(YYYYMM)), 13)) %>% dplyr::left_join( y = tmrecat %>% dplyr::select( Dataset, Call.subject, Category ), by = c('Call_Subject' = 'Call.subject') ) %>% split(.$Type) tmeq <- tm$Instrument %>% dplyr::mutate( Analyzer = dplyr::case_when( .$Line_Desc %in% c('ORTHO SUMMIT PROCESSOR', 'OSP 24/20 - Refurbished', 'Ortho Summis Process 24/20') ~ 'OSP', .$Prod_No_Desc %in% c('1585 AutoVue Innova', '1588 AutoVue Ultra', 'SWINNOVA AutoVue Innova Software', 'SWULTRA AutoVue Ultra Software') ~ 'AUTOVUE IU', .$Line_Desc == 'MTS ProVue Analyzer' ~ 'PROVUE', .$Prod_No_Desc %in% c('6002 ORTHO VISION BV', '6003 ORTHO VISION MAX BV') ~ 'VISION MAX BV', .$Prod_No_Desc %in% c('6904577 ORTHO VISION ID-MTS', '6904576 ORTHO VISION MAX ID-MTS', '5000 ORTHO VISION ID-MTS') ~ 'VISION MTS', .$Prod_No_Desc %in% c('SWVISION Ortho Vision Software', 'SWVMAX Ortho Vision Max Software') & .$Country_Code %in% c('CA', 'US') ~ 'VISION MTS', .$Prod_No_Desc %in% c('SWVISION Ortho Vision Software', 'SWVMAX Ortho Vision Max Software') ~ 'VISION MAX BV', TRUE ~ 'Other' ) ) %>% join_region() tmre <- tm$Reagent %>% join_region() regions <- c('GLOBAL', 'NAR', 'EMEA', 'LAR', 'ASPAC', 'CHINA', 'JAPAN', 'CANADA', 'INDIA') ib <- qrc_query(db = 'qrc_raw', query = 'SELECT * FROM installbase;') %>% dplyr::mutate(region = dplyr::case_when( .$country == 'INDIA' ~ 'INDIA', .$country == 'CANADA' ~ 'CANADA', TRUE ~ .$region )) %>% dplyr::group_by(region, yyyymm, analyzer) %>% dplyr::summarise(installbase = sum(installbase))
out <- NULL for (region in regions) { out <- c( out, knitr::knit_expand( text = paste0( '\n{{region}} {data-navmenu=\'Region\'}', '\n=====================================\n', '\nColumn {.tabset .tabset-fade}', '\n-------------------------------------', '\n\n### Overall Summary', '\n```r}-summ}', '\nregion_summary(\'{{region}}\')', '\n```', '\n\n### CLRE Summary', '\n```r}-clre}', '\nviz <- clre_summary(\'{{region}}\')', '\ngrob_binder(ggrob = viz$bytechplot, tgrob = viz$bytechtab)', '\n```', '\n\n### CLRE Complaints by Call Subject', '\n```r}-clrecs}', '\nmake_basic_table(viz$bycs)', '\n```', '\n\n### CLEQ Complaints', '\n```r}-cleq}', '\nviz <- cleq_summary(\'{{region}}\')', '\ngrob_binder(ggrob = viz$countplot, tgrob = viz$counttab)', '\n```', '\n\n### CLEQ Normalized Complaints', '\n```r}-cleqnorm}', '\ngrob_binder(ggrob = viz$normplot, tgrob = viz$normtab)', '\n```', '\n\n### TMRE Summary', '\n```r}-tmre}', '\nviz <- tmre_summary(\'{{region}}\')', '\ngrob_binder(tgrob = viz$t, ggrob = viz$g)', '\n```', '\n\n### TMRE Compaints by Call Subject', '\n```r}-tmrecs}', '\nmake_basic_table(viz$bycs)', '\n```', '\n\n### TMEQ Complaints', '\n```r}-tmeq}', '\nviz <- tmeq_summary(\'{{region}}\')', '\ngrob_binder(tgrob = viz$counttab, ggrob = viz$countplot)', '\n```', '\n\n### TMEQ Normalized Complaints', '\n```r}-tmeqnorm}', '\ngrob_binder(tgrob = viz$normtab, ggrob = viz$normplot)', '\n```' ), region = region ) ) }
r knitr::knit(text = out)
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.