knitr::opts_chunk$set(fig.width = 8)
country_filter <- . %>% dplyr::filter(Country_Code %in% countries$Country_Code) counter <- . %>% { if ('Country_Code' %in% names(.)) { dplyr::group_by(., Type, Country_Code) %>% dplyr::summarise(., complaints = n()) } else { as.null(.) }} 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)) ) grob_binder <- function(ggrob, tgrob) { tgrob$heights <- unit.pmax(tgrob$heights) 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) } extract_summary <- function(string) { desc <- stringr::str_split(string, '\\\r\\\n', simplify = TRUE) %>% as.character() %>% trimws() %>% paste(collapse = ' ') summary <- stringr::str_match(desc, 'PROBLEM STATEMENT.(.*?)CUSTOMER IS COMPLAINING ABOUT') %>% as.character() %>% tail(1) %>% trimws() if (summary == '' || is.na(summary)) { summary <- stringr::str_match(desc, 'CUSTOMER IS COMPLAINING ABOUT.(.*?)COMPLAINANT') %>% as.character() %>% tail(1) %>% trimws() } if (is.na(summary)) { return(stringr::str_split(string, pattern = '\\\r\\\n', simplify = TRUE) %>% as.character() %>% trimws() %>% .[1]) } return(summary) } complaints_summary <- function(country) { country_name <- countries$Country[countries$Country_Code == country] types <- c('CLEQ', 'CLRE', 'TMEQ', 'TMRE') clre_df <- clre[[country]] %>% {if (is.null(.)) {.} else {dplyr::mutate(., Type = 'CLRE')}} cleq_df <- cleq[[country]] %>% {if (is.null(.)) {.} else {dplyr::mutate(., Type = 'CLEQ')}} tmre_df <- tmre[[country]] %>% { if (is.null(.)) { . } else { dplyr::mutate(., Type = 'TMRE') %>% dplyr::rename(dummy = Call_Subject, Call_Subject = Category) } } tmeq_df <- tmeq[[country]] %>% {if (is.null(.)) {.} else {dplyr::mutate(., Type = 'TMEQ')}} if (is.null(c(clre_df, cleq_df, tmre_df, tmeq_df))) { text_list <- vector('list', 4) %>% setNames(types) for (type in types) { text_list[[type]] <- textGrob(paste('No', type, 'complaints in', stringr::str_to_title(country_name), 'during this time period.')) } return(text_list) } if (!is.null(c(clre_df, cleq_df))) { cl_df <- rbind(clre_df, cleq_df) %>% dplyr::select( Type, J_Number, Complaint_Nbr___CH, Create_Audit_DT, Call_Subject, Call_Area, Problem_Description ) %>% dplyr::rename(Complaint_Number = Complaint_Nbr___CH, J_No = J_Number, Complaint_Date = Create_Audit_DT) %>% dplyr::mutate( Complaint_Date = purrr::map_chr(Complaint_Date, ~ strftime(.x, format = '%Y-%m-%d %H:%M:%S')) ) } else { cl_df <- NULL } tm_parser <- . %>% dplyr::select( Type, J_Number, Complaint_Nbr, Create_Audit_DT, Call_Subject, Call_Area, Problem_Desc ) %>% dplyr::rename(Complaint_Number = Complaint_Nbr, J_No = J_Number, Complaint_Date = Create_Audit_DT, Problem_Description = Problem_Desc) %>% dplyr::mutate( Complaint_Date = purrr::map_chr(Complaint_Date, ~ strftime(.x, format = '%Y-%m-%d %H:%M:%S')) ) if (!is.null(c(tmre_df, tmeq_df))) { tm_df <- rbind(tmre_df %>% {if (is.null(.)) {.} else {tm_parser(.)}}, tmeq_df %>% {if (is.null(.)) {.} else {tm_parser(.)}}) } else { tm_df <- NULL } df_list <- rbind(cl_df, tm_df) %>% dplyr::mutate(Complaint_Summary = purrr::map(Problem_Description, ~ extract_summary(.x))) %>% dplyr::select(-Problem_Description) %>% split(.$Type) for (type in types[-match(names(df_list), types)]) { df_list[[type]] <- textGrob(paste('No', type, 'complaints in', stringr::str_to_title(country_name), 'during this time period.')) } return(df_list) } renderer <- function(item) { if (any(class(item) == 'grob')) { grid.draw(item) } else { make_basic_table(df = item) } }
daterange <- strftime(c(srms::last_month(), lubridate::floor_date(Sys.time(), 'month')), format = '%Y-%m-%d') countries <- srms::srms_table('country_codes') %>% dplyr::filter(Region == 'LAR') clre <- srms::roc_re_v26b(add = 'audit', daterange = daterange) %>% country_filter() %>% split(.$Country_Code) cleq <- srms::roc_eq_v26b(add = 'audit', daterange = daterange) %>% country_filter() %>% split(.$Country_Code) tm <- srms::tm_general_template(daterange = daterange) %>% country_filter() %>% dplyr::filter(Call_Subject != 'NONPROD') %>% dplyr::mutate(Type = ifelse(Call_Type %in% c('CE', 'PHSE', 'CERE', 'CSW'), 'Instrument', 'Reagent')) %>% dplyr::left_join( y = tmrecat %>% dplyr::select( Dataset, Call.subject, Category ), by = c('Call_Subject' = 'Call.subject') ) %>% split(.$Type) if ('Reagent' %in% names(tm)) { tmre <- tm$Reagent %>% split(.$Country_Code) } else { tmre <- NULL } tmeq <- tm$Instrument %>% split(.$Country_Code) groups <- c('AR', 'BR', 'CL', 'CO', 'MX', 'PA', 'PR', 'UY', 'VE') types <- c('CLRE', 'CLEQ', 'TMRE', 'TMEQ')
df <- tibble::tibble(Country_Code = rep(groups, each = 4), Type = rep(types, length(groups))) %>% dplyr::left_join( y = rbind( clre %>% dplyr::bind_rows() %>% dplyr::mutate(Type = 'CLRE') %>% counter(), cleq %>% dplyr::bind_rows() %>% dplyr::mutate(Type = 'CLEQ') %>% counter(), tmre %>% dplyr::bind_rows() %>% dplyr::mutate(Type = 'TMRE') %>% counter(), tmeq %>% dplyr::bind_rows() %>% dplyr::mutate(Type = 'TMEQ') %>% counter() ), by = c('Type', 'Country_Code') ) %>% dplyr::left_join( y = countries %>% dplyr::select(Country, Country_Code), by = 'Country_Code' ) %>% dplyr::select(-Country_Code) tgrob <- df %>% tidyr::spread(Country, complaints, fill = 0) %>% add_margins() %>% tableGrob(row = NULL, theme = mytheme) ggrob <- ggplotGrob( ggplot(df, aes(x = Country, y = complaints, fill = Type)) + geom_col(color = 'black', position = 'dodge') + scale_fill_tableau() + theme(legend.position = 'top', axis.title.x = element_blank()) + ggtitle(paste0('LATAM Complaints: ', strftime(daterange[1], format = '%B %Y'))) ) grob_binder(ggrob = ggrob, tgrob = tgrob)
out <- NULL for (group in groups) { out <- c( out, knitr::knit_expand( text = paste0( '\n{{country_name}} {data-navmenu=\'Country\'}', '\n=====================================\n', '\nColumn {.tabset .tabset-fade}', '\n-------------------------------------', '\n\n### CLEQ Summary', '\n```r}-cleq}', '\nitems <- complaints_summary(\'{{group}}\')', '\nrenderer(items$CLEQ)', '\n```', '\n\n### CLRE Summary', '\n```r}-clre}', '\nrenderer(items$CLRE)', '\n```', '\n\n### TMEQ Summary', '\n```r}-tmeq}', '\nrenderer(items$TMEQ)', '\n```', '\n\n### TMRE Summary', '\n```r}-tmre}', '\nrenderer(items$TMRE)', '\n```' ), country_name = countries$Country[countries$Country_Code == group], group = group ) ) }
r knitr::knit(text = out)
df <- rbind(dplyr::bind_rows(clre) %>% dplyr::select(Complaint_Nbr___CH, Problem_Description) %>% dplyr::rename(Complaint_Nbr = Complaint_Nbr___CH), dplyr::bind_rows(cleq) %>% dplyr::select(Complaint_Nbr___CH, Problem_Description) %>% dplyr::rename(Complaint_Nbr = Complaint_Nbr___CH), dplyr::bind_rows(tmre) %>% { if (nrow(.) != 0) { dplyr::select(., Complaint_Nbr, Problem_Desc) %>% dplyr::rename(., Problem_Description = Problem_Desc) } else { . }}, dplyr::bind_rows(tmeq) %>% dplyr::select(Complaint_Nbr, Problem_Desc) %>% dplyr::rename(Problem_Description = Problem_Desc)) %>% dplyr::mutate(Problem_Description = gsub('\\\r\\\n', '<br/>', Problem_Description)) DT::datatable( data = df, options = list(dom = 'ft', scrollY = '300px', paging = FALSE), rownames = FALSE, colnames = gsub('\\.|_' ,' ', names(df)), escape = FALSE )
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.