knitr::opts_chunk$set(fig.width = 8)
add_title <- function(grob, title) { title <- textGrob(title, gp = gpar(fontsize = 8)) padding <- unit(5, 'mm') grob <- gtable::gtable_add_rows(grob, heights = grobHeight(title) + padding, pos = 0) grob <- gtable::gtable_add_grob(grob, title, t = 1, l = 1, r = ncol(grob)) return(grob) } # merge duplicate rows vertically, very fragile merge_rows <- function(df, groups) { 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)) ) mask <- df$LOB == '' df$LOB[mask] <- 1:sum(mask) borders <- df %>% dplyr::filter(LOB != '') %>% dplyr::mutate(row_ind = row_number() + 1) %>% dplyr::group_by_(.dots = groups) %>% dplyr::summarise(top = min(row_ind), bottom = max(row_ind)) %>% dplyr::arrange(top) %>% dplyr::ungroup() %>% dplyr::mutate(LOB = replace(LOB, LOB %in% as.character(1:sum(mask)), '')) col1 <- tableGrob(borders[1], row = NULL, theme = mytheme) col2 <- tableGrob(borders[2], row = NULL, theme = mytheme) col3 <- tableGrob(df[-(1:2)], row = NULL, theme = mytheme) halign <- combine(col1, col2, col3, along = 1) halign$layout[halign$layout$t != 1 & halign$layout$l == 1, 't'] <- borders$top halign$layout[halign$layout$b != 1 & halign$layout$l == 1, 'b'] <- borders$bottom halign$layout[halign$layout$t != 1 & halign$layout$l == 2, 't'] <- borders$top halign$layout[halign$layout$b != 1 & halign$layout$l == 2, 'b'] <- borders$bottom return(halign) } cbind_tgrobs <- function(t1, t2) { t2$heights <- unit(rep(1/nrow(t2), nrow(t2)), 'npc') t2$widths <- unit.pmax(t2$widths, unit(2, 'lines')) t1 %<>% gtable_add_cols(., unit(.5, 'cm')) t1 %<>% gtable_add_cols(., sum(t2$widths)) t1 %<>% gtable_add_grob(., t2, t = 1, l = ncol(t1), b = nrow(t2), r = ncol(t1)) grid.draw(t1) invisible(t1) } get_tables <- function(df) { 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)) ) cl_fam <- df %>% dplyr::mutate(YYYYMM = strftime(Create_Audit_Date, format = '%Y%m')) %>% dplyr::filter(YYYYMM == max(YYYYMM), LOB == 'Clinical Chemistry') %>% dplyr::group_by(Type, LOB, Family_Code) %>% dplyr::summarise(Complaints = n()) %>% split(., .$Type) %>% lapply(function(x) x %>% dplyr::ungroup() %>% srms::add_margins()) %>% do.call(rbind, .) %>% dplyr::select(-Total) %>% merge_rows(., groups = c('Type', 'LOB')) cl_tech <- df %>% dplyr::mutate(YYYYMM = strftime(Create_Audit_Date, format = '%Y%m')) %>% dplyr::filter(YYYYMM == max(YYYYMM), LOB == 'Clinical Chemistry', Type == 'Reagent') %>% dplyr::group_by(Technology) %>% dplyr::summarise(Complaints = n()) %>% srms::add_margins() %>% dplyr::select(-Total) %>% tableGrob(., row = NULL, theme = mytheme) ih_fam <- df %>% dplyr::mutate(YYYYMM = strftime(Create_Audit_Date, format = '%Y%m')) %>% dplyr::filter(YYYYMM == max(YYYYMM), LOB == 'Immunohematology') %>% dplyr::group_by(LOB, Family_Code, Type) %>% dplyr::summarise(Complaints = n()) %>% split(., .$Family_Code) %>% lapply(function(x) x %>% dplyr::ungroup() %>% srms::add_margins()) %>% do.call(rbind, .) %>% dplyr::select(-Total) %>% merge_rows(., groups = c('LOB', 'Family_Code')) ih_group <- df %>% dplyr::mutate(YYYYMM = strftime(Create_Audit_Date, format = '%Y%m')) %>% dplyr::filter(YYYYMM == max(YYYYMM), LOB == 'Immunohematology', !is.na(Dataset)) %>% dplyr::group_by(Dataset) %>% dplyr::summarise(Complaints = n()) %>% srms::add_margins() %>% dplyr::select(-Total) %>% tableGrob(., row = NULL, theme = mytheme) tables <- list(cl_fam = cl_fam, cl_tech = cl_tech, ih_fam = ih_fam, ih_group = ih_group) tables$cl_fam %<>% add_title(grob = ., title = 'CL Complaints by Family') tables$cl_tech %<>% add_title(grob = ., title = 'CL Complaints by Tech.') tables$ih_fam %<>% add_title(grob = ., title = 'IH Complaints by Family') tables$ih_group %<>% add_title(grob = ., title = 'IH Complaints by Group') return(tables) } 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) } perc_time_graph <- function(df) { g <- ggplot(data = df %>% dplyr::mutate(perc = Complaints / sum(Complaints)), aes(x = YYYYMM, y = perc, group = Family_Code, color = Family_Code)) + geom_point() + geom_line() + labs(y = 'Percentage of Complaints') + theme(axis.title.x = element_blank(), legend.position = 'top', legend.text = element_text(size = 8)) return(g) } time_wide_table <- function(df) { df %>% tidyr::spread(key = YYYYMM, value = Complaints) %>% dplyr::mutate_each(dplyr::funs(replace(., is.na(.), 0))) %>% dplyr::ungroup() %>% srms::add_margins() %>% dplyr::select(-Type, -Total) } 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) } 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 = ncol(ggrob)) grid.draw(ggrob) invisible(ggrob) }
ca_df <- srms::canada_preprocess(write = FALSE) aged90day <- srms::aged_90day() %>% dplyr::mutate(LOB = ifelse(`Family Code` %in% c('MTS', 'PROVUE', 'VISION MTS', 'WORKSTATION MTS', 'BLOOD BANK'), 'Immunohematology', 'Clinical Chemistry'), Type = ifelse(`Call Type` %in% c('CE', 'PHSE', 'CERE', 'CSW'), 'Instrument', 'Reagent')) names(aged90day) <- gsub(' ', '.', names(aged90day))
tables <- get_tables(df = ca_df) cbind_tgrobs(tables$cl_fam, tables$cl_tech)
cbind_tgrobs(tables$ih_fam, tables$ih_group)
g <- ggplotGrob( ggplot(data = aged90day %>% dplyr::filter(Country.Code == 'CA'), aes(x = Type)) + geom_bar(aes(fill = On.Time.Metric), alpha = .5, color = 'black', position = 'fill') + geom_text(data = aged90day %>% dplyr::filter(Country.Code == 'CA') %>% dplyr::group_by(LOB, Type, On.Time.Metric) %>% dplyr::summarise(Complaints = n()) %>% dplyr::do(dplyr::arrange(., desc(On.Time.Metric))) %>% dplyr::mutate( perc = paste0(round(Complaints / sum(Complaints) * 100, 1), '%'), y = cumsum(Complaints / sum(Complaints)) ), aes(x = Type, y = y, label = perc), vjust = 'inward') + facet_wrap(~ LOB) + scale_fill_manual(values = c('Not On Time' = 'red', 'On Time' = 'green')) + labs(y = 'Percentage of Complaints') + theme(panel.grid.major = element_blank(), panel.grid.minor = element_blank(), axis.title.x = element_blank()) ) table <- tableGrob( aged90day %>% dplyr::filter(Country.Code == 'CA') %>% dplyr::group_by(LOB, Type, On.Time.Metric) %>% dplyr::summarise(Complaints = n()) %>% dplyr::mutate(key = ifelse(LOB == 'Clinical Chemistry', paste0('CL_', Type), paste0('IH_', Type))) %>% dplyr::ungroup() %>% dplyr::select(-LOB, -Type) %>% tidyr::spread(key = key, value = Complaints) %>% dplyr::mutate_each(dplyr::funs(replace(., is.na(.), 0))) %>% srms::add_margins(), row = NULL, theme = ttheme_default( core = list(fg_params = list(cex = .5)), colhead = list(fg_params = list(cex = .5)), rowhead = list(fg_params = list(cex = .5))) ) grob_binder(ggrob = g, tgrob = table)
table <- ca_df %>% dplyr::mutate(YYYYMM = strftime(Create_Audit_Date, format = '%Y%m')) %>% dplyr::filter(LOB == 'Clinical Chemistry', !is.na(Technology)) %>% dplyr::group_by(YYYYMM, Technology) %>% dplyr::summarise(Complaints = n()) g <- ggplotGrob( ggplot(data = table, aes(x = YYYYMM, y = Complaints, fill = Technology)) + geom_col(position = 'dodge', color = 'black') + theme(axis.title.x = element_blank()) ) table %<>% tidyr::spread(key = YYYYMM, value = Complaints) %>% srms::add_margins() %>% dplyr::select(-Total) t <- tableGrob( table, row = NULL, theme = ttheme_default( core = list(fg_params = list(cex = .5), bg_params = list(fill = get_row_bg(table))), colhead = list(fg_params = list(cex = .5)), rowhead = list(fg_params = list(cex = .5))) ) grob_binder(ggrob = g, tgrob = t)
tables <- ca_df %>% dplyr::mutate(YYYYMM = strftime(Create_Audit_Date, format = '%Y%m')) %>% dplyr::filter(LOB == 'Clinical Chemistry') %>% dplyr::group_by(YYYYMM, Type, Family_Code) %>% dplyr::summarise(Complaints = n()) %>% split(., .$Type) grid.draw(ggplotGrob(perc_time_graph(tables$Instrument)))
table <- tables$Instrument %>% time_wide_table() t <- tableGrob( table, row = NULL, theme = ttheme_default( core = list(fg_params = list(cex = .5), bg_params = list(fill = get_row_bg(table))), colhead = list(fg_params = list(cex = .5)), rowhead = list(fg_params = list(cex = .5))) ) grid.draw(t)
grid.draw(ggplotGrob(perc_time_graph(tables$Reagent)))
table <- tables$Reagent %>% time_wide_table() t <- tableGrob( table, row = NULL, theme = ttheme_default( core = list(fg_params = list(cex = .5), bg_params = list(fill = get_row_bg(table))), colhead = list(fg_params = list(cex = .5)), rowhead = list(fg_params = list(cex = .5))) ) grid.draw(t)
table <- ca_df %>% dplyr::mutate(YYYYMM = strftime(Create_Audit_Date, format = '%Y%m')) %>% dplyr::filter(LOB == 'Immunohematology', !is.na(Dataset)) %>% dplyr::group_by(YYYYMM, Dataset) %>% dplyr::summarise(Complaints = n()) g <- ggplotGrob( ggplot(data = table, aes(x = YYYYMM, y = Complaints, fill = Dataset)) + geom_col(position = 'dodge', color = 'black') + theme(axis.title.x = element_blank(), legend.position = 'top') ) grid.draw(g)
table %<>% tidyr::spread(key = YYYYMM, value = Complaints) %>% srms::add_margins() %>% dplyr::select(-Total) t <- tableGrob( table, row = NULL, theme = ttheme_default( core = list(fg_params = list(cex = .5), bg_params = list(fill = get_row_bg(table))), colhead = list(fg_params = list(cex = .5)), rowhead = list(fg_params = list(cex = .5))) ) grid.draw(t)
tables <- ca_df %>% dplyr::mutate(YYYYMM = strftime(Create_Audit_Date, format = '%Y%m')) %>% dplyr::filter(LOB == 'Immunohematology') %>% dplyr::group_by(YYYYMM, Type, Family_Code) %>% dplyr::summarise(Complaints = n()) %>% split(., .$Type) g <- ggplotGrob(perc_time_graph(tables$Instrument)) grid.draw(g)
table <- tables$Instrument %>% time_wide_table() t <- tableGrob( table, row = NULL, theme = ttheme_default( core = list(fg_params = list(cex = .5), bg_params = list(fill = get_row_bg(table))), colhead = list(fg_params = list(cex = .5)), rowhead = list(fg_params = list(cex = .5))) ) grid.draw(t)
grid.draw(ggplotGrob(perc_time_graph(tables$Reagent)))
table <- tables$Reagent %>% time_wide_table() t <- tableGrob( table, row = NULL, theme = ttheme_default( core = list(fg_params = list(cex = .5), bg_params = list(fill = get_row_bg(table))), colhead = list(fg_params = list(cex = .5)), rowhead = list(fg_params = list(cex = .5))) ) grid.draw(t)
table <- ca_df %>% dplyr::mutate(YYYYMM = strftime(Create_Audit_Date, format = '%Y%m')) %>% dplyr::filter(YYYYMM == max(YYYYMM), LOB == 'Clinical Chemistry', Type == 'Reagent') %>% dplyr::group_by(Call_Subject, Technology) %>% dplyr::summarise(Complaints = n()) %>% dplyr::arrange(-Complaints) %>% dplyr::ungroup() %>% dplyr::mutate(Percent.of.Total = paste0( round(cumsum(Complaints / sum(Complaints) * 100), 1), '%' )) make_basic_table(table)
table <- ca_df %>% dplyr::mutate(YYYYMM = strftime(Create_Audit_Date, format = '%Y%m')) %>% dplyr::filter(YYYYMM == max(YYYYMM), LOB == 'Clinical Chemistry', Type == 'Instrument') %>% dplyr::group_by(Call_Subject, Family_Code) %>% dplyr::summarise(Complaints = n()) %>% dplyr::arrange(-Complaints) %>% dplyr::ungroup() %>% dplyr::mutate(Percent.of.Total = paste0( round(cumsum(Complaints / sum(Complaints) * 100), 1), '%' )) make_basic_table(table)
table <- ca_df %>% dplyr::mutate(YYYYMM = strftime(Create_Audit_Date, format = '%Y%m')) %>% dplyr::filter(YYYYMM == max(YYYYMM), LOB == 'Immunohematology', Type == 'Reagent') %>% dplyr::group_by(Category) %>% dplyr::summarise(Complaints = n()) %>% dplyr::arrange(-Complaints) %>% dplyr::ungroup() %>% dplyr::mutate(Percent.of.Total = paste0( round(cumsum(Complaints / sum(Complaints) * 100), 1), '%' )) make_basic_table(table)
table <- ca_df %>% dplyr::mutate(YYYYMM = strftime(Create_Audit_Date, format = '%Y%m')) %>% dplyr::filter(YYYYMM == max(YYYYMM), LOB == 'Immunohematology', Type == 'Instrument') %>% dplyr::group_by(Call_Subject, Family_Code) %>% dplyr::summarise(Complaints = n()) %>% dplyr::arrange(-Complaints) %>% dplyr::ungroup() %>% dplyr::mutate(Percent.of.Total = paste0( round(cumsum(Complaints / sum(Complaints) * 100), 1), '%' )) make_basic_table(table)
table <- ca_df %>% dplyr::mutate(YYYYMM = strftime(Create_Audit_Date, format = '%Y%m')) %>% dplyr::filter(YYYYMM == max(YYYYMM), LOB == 'Clinical Chemistry', Type == 'Reagent') %>% dplyr::group_by(Customer_Name) %>% dplyr::summarise(Complaints = n()) %>% dplyr::arrange(-Complaints) %>% dplyr::ungroup() %>% dplyr::mutate(Percent.of.Total = paste0( round(cumsum(Complaints / sum(Complaints) * 100), 1), '%' )) make_basic_table(table)
table <- ca_df %>% dplyr::mutate(YYYYMM = strftime(Create_Audit_Date, format = '%Y%m')) %>% dplyr::filter(YYYYMM == max(YYYYMM), LOB == 'Clinical Chemistry', Type == 'Instrument') %>% dplyr::group_by(Customer_Name) %>% dplyr::summarise(Complaints = n()) %>% dplyr::arrange(-Complaints) %>% dplyr::ungroup() %>% dplyr::mutate(Percent.of.Total = paste0( round(cumsum(Complaints / sum(Complaints) * 100), 1), '%' )) make_basic_table(table)
table <- ca_df %>% dplyr::mutate(YYYYMM = strftime(Create_Audit_Date, format = '%Y%m')) %>% dplyr::filter(YYYYMM == max(YYYYMM), LOB == 'Immunohematology', Type == 'Reagent') %>% dplyr::group_by(Customer_Name) %>% dplyr::summarise(Complaints = n()) %>% dplyr::arrange(-Complaints) %>% dplyr::ungroup() %>% dplyr::mutate(Percent.of.Total = paste0( round(cumsum(Complaints / sum(Complaints) * 100), 1), '%' )) make_basic_table(table)
table <- ca_df %>% dplyr::mutate(YYYYMM = strftime(Create_Audit_Date, format = '%Y%m')) %>% dplyr::filter(YYYYMM == max(YYYYMM), LOB == 'Immunohematology', Type == 'Instrument') %>% dplyr::group_by(Customer_Name) %>% dplyr::summarise(Complaints = n()) %>% dplyr::arrange(-Complaints) %>% dplyr::ungroup() %>% dplyr::mutate(Percent.of.Total = paste0( round(cumsum(Complaints / sum(Complaints) * 100), 1), '%' )) make_basic_table(table)
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.