In kimjam/srms: Package to automate tasks and reporting for OCD SRMS Team.
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))
Month Summary {data-navmenu='Section'}
Column {.tabset .tabset-fade}
CL Complaints
tables <- get_tables(df = ca_df)
cbind_tgrobs(tables$cl_fam, tables$cl_tech)
IH Complaints
cbind_tgrobs(tables$ih_fam, tables$ih_group)
Open Status Summary
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)
Clinical Chemistry Summary {data-navmenu='Section'}
Column {.tabset .tabset-fade}
CL Complaints by Technology Over Time
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)
CL EQ Complaints Over Time Chart
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)))
CL EQ Complaints Over Time Table
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)
CL RE Complaints Over Time Chart
grid.draw(ggplotGrob(perc_time_graph(tables$Reagent)))
CL RE Complaints Over Time Table
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)
Immunohematology Summary {data-navmenu='Section'}
Column {.tabset .tabset-fade}
IH Complaints by Group Over Time Chart
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)
IH Complaints by Group Over Time Table
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)
IH EQ Complaints Over Time Chart
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)
IH EQ Complaints Over Time Table
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)
IH RE Complaints Over Time Chart
grid.draw(ggplotGrob(perc_time_graph(tables$Reagent)))
IH RE Complaints Over Time Table
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)
Call Subject Summary {data-navmenu='Section'}
Column {.tabset .tabset-fade}
CL Reagent
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)
CL Equipment
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)
Column {.tabset .tabset-fade}
IH Regent
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)
IH Equipment
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)
Customer Summary {data-navmenu='Section'}
Column {.tabset .tabset-fade}
CL Reagent
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)
CL Equipment
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)
Column {.tabset .tabset-fade}
IH Reagent
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)
IH Equipment
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)
kimjam/srms documentation built on May 20, 2019, 10:21 p.m.
R Package Documentation
Browse R Packages
We want your feedback!
Note that we can't provide technical support on individual packages. You should contact the package authors for that.
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))
Month Summary {data-navmenu='Section'}
Column {.tabset .tabset-fade}
CL Complaints
tables <- get_tables(df = ca_df) cbind_tgrobs(tables$cl_fam, tables$cl_tech)
IH Complaints
cbind_tgrobs(tables$ih_fam, tables$ih_group)
Open Status Summary
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)
Clinical Chemistry Summary {data-navmenu='Section'}
Column {.tabset .tabset-fade}
CL Complaints by Technology Over Time
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)
CL EQ Complaints Over Time Chart
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)))
CL EQ Complaints Over Time Table
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)
CL RE Complaints Over Time Chart
grid.draw(ggplotGrob(perc_time_graph(tables$Reagent)))
CL RE Complaints Over Time Table
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)
Immunohematology Summary {data-navmenu='Section'}
Column {.tabset .tabset-fade}
IH Complaints by Group Over Time Chart
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)
IH Complaints by Group Over Time Table
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)
IH EQ Complaints Over Time Chart
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)
IH EQ Complaints Over Time Table
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)
IH RE Complaints Over Time Chart
grid.draw(ggplotGrob(perc_time_graph(tables$Reagent)))
IH RE Complaints Over Time Table
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)
Call Subject Summary {data-navmenu='Section'}
Column {.tabset .tabset-fade}
CL Reagent
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)
CL Equipment
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)
Column {.tabset .tabset-fade}
IH Regent
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)
IH Equipment
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)
Customer Summary {data-navmenu='Section'}
Column {.tabset .tabset-fade}
CL Reagent
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)
CL Equipment
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)
Column {.tabset .tabset-fade}
IH Reagent
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)
IH Equipment
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)
R Package Documentation
Browse R Packages
We want your feedback!
Note that we can't provide technical support on individual packages. You should contact the package authors for that.
Embedding an R snippet on your website
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.