library(qrcutils)
find_cell <- function(table, row, col, name="core-fg"){ l <- table$layout which(l$t==row & l$l==col & l$name==name) }
tm_cols <- stringr::str_interp(c( 'complaint_number, create_audit_date, prod_no_desc, call_type, ', 'call_subject, call_subject_desc, call_area, lot_serial_number, ', 'business_unit_desc, product_cat, resolution, line_desc, group_desc, ', 'country_code, problem_desc, yyyymm' )) start_date <- strftime( lubridate::floor_date(Sys.time(), 'week') - lubridate::ddays(59), format = '%Y-%m-%d' ) end_date <- strftime( lubridate::floor_date(Sys.time(), 'week') + lubridate::ddays(1), format = '%Y-%m-%d' ) tmrecat <- qrcutils::qrc_query(db = 'qrc_link', query = 'SELECT * FROM tmrecat;') rbc_callsubjs <- stringr::str_interp(c( "'ALBAZ469', 'ALBAZ488', 'ALBAZ497', 'ALBAZ498', '6901862', '6901863', ", "'6901864', '6901865', '6901866', '6901867', '6901861', '6901862', ", "'6901863', '6901864', '6901865', '6901866', '6901867', '6901868', ", "'6902096', '707910', '707930', '707940', '707950', '719000', '719100', ", "'719210', '719220', '719310', '719410', '719510', '719520', '719610', ", "'7198041', '719810', '719812', '719816', '6902314', '6902315', '6902316', ", "'6902317', '6902318', '6902319', '718820', '718825', '718830', '719102', ", "'719111', '719201', '719202', '719211', '719212', '719221', '719402', ", "'719502', '719522', '719602', '707790', '719818', '719819', '6842785', ", "'7196771', '957793', '7191041', '7192041', '7192042', '7196041', ", "'ALBAZ263', 'ALBAZ441', 'ALBAZ466'" )) ## update this once a year alert_limit <- tibble::tibble( call_area = c('BCILLEG', 'BCNOTRED', 'CONTUNOP', 'LEAKSPIL', 'LCROOK', 'PARTIC', 'UNEXHEM'), call_area_label = c(rep('BCILLEG/BCNOTRED', 2), 'CONTUNOP', rep('LEAKSPIL/LCROOK', 2), 'PARTIC', 'UNEXHEM'), alert_limit = c(rep(12, 2), 5, rep(9, 2), 5, 15) ) tm <- rbind( qrcutils::qrc_query( db = 'qrc_raw', query = stringr::str_interp(c( 'SELECT ${tm_cols} FROM roctm_mo WHERE ', 'create_audit_date <= \'${end_date}\' and ', 'call_subject in (${rbc_callsubjs});' )) ), qrcutils::qrc_query( db = 'qrc_raw', query = stringr::str_interp(c('SELECT ${tm_cols} FROM roctm WHERE', ' create_audit_date >= \'${start_date}\' and', ' call_subject in (${rbc_callsubjs});')) ) ) %>% dplyr::mutate(week_start_date = lubridate::floor_date(create_audit_date, 'week')) rbc_summary <- tm %>% dplyr::group_by(call_area, lot_serial_number, call_subject, call_subject_desc, resolution, country_code, week_start_date) %>% dplyr::summarise(complaints = n()) %>% dplyr::arrange(-complaints) %>% dplyr::ungroup() rbc_cs <- rbc_summary %>% dplyr::group_by(call_area, lot_serial_number, call_subject, call_subject_desc) %>% dplyr::summarise(complaints = sum(complaints)) %>% dplyr::filter(complaints >= 5) rbc_res <- rbc_summary %>% dplyr::filter(call_area %in% rbc_cs$call_area, lot_serial_number %in% rbc_cs$lot_serial_number) %>% dplyr::group_by(call_area, lot_serial_number, resolution) %>% dplyr::summarise(complaints = sum(complaints)) %>% tidyr::spread(resolution, complaints, fill = 0) %>% qrcutils::add_margins() rbc_country <- rbc_summary %>% dplyr::filter(call_area %in% rbc_cs$call_area, lot_serial_number %in% rbc_cs$lot_serial_number) %>% dplyr::group_by(call_area, lot_serial_number, country_code, call_subject_desc) %>% dplyr::summarise(complaints = sum(complaints)) dates <- sort(unique(rbc_summary$week_start_date))
grid.draw(qrcutils::merge_rows(df = rbc_cs, n = 1))
rbc_summary %>% dplyr::group_by(call_area, lot_serial_number, week_start_date) %>% dplyr::summarise(complaints = sum(complaints)) %>% tidyr::spread(week_start_date, complaints, fill = 0) %>% dplyr::filter( paste(call_area, lot_serial_number) %in% paste(rbc_cs$call_area, rbc_cs$lot_serial_number) ) %>% tidyr::gather(week_start_date, complaints, -(call_area:lot_serial_number)) %>% tidyr::nest() %>% dplyr::mutate( data = purrr::map( data, ~.x %>% dplyr::mutate( week_start_date = as.POSIXct(strptime(week_start_date, format = '%Y-%m-%d')), complaints = cumsum(complaints) ) ) ) %>% tidyr::unnest() %>% dplyr::mutate(group = paste(call_area, lot_serial_number, sep = ' : ')) %>% ggplot(aes(x = week_start_date, y = complaints, group = group)) + geom_point() + geom_line() + geom_text_repel(aes(label = complaints)) + geom_hline(yintercept = 5, linetype = 'dashed', color = 'red') + facet_wrap(~group, ncol = 2) + labs(title = 'Cumulative Count of Complaints by Week', y = 'Cumulative Complaint Count') + scale_x_datetime(breaks = dates) + theme(axis.title.x = element_blank(), axis.text.x = element_text(angle = 90, hjust = 1, vjust = .5), panel.grid.minor.x = element_blank(), panel.grid.minor.y = element_blank())
grid.draw(qrcutils::merge_rows(df = rbc_res, n = 1))
grid.draw(qrcutils::merge_rows(df = rbc_country, n = 1))
systemic <- rbc_summary %>% dplyr::right_join(y = alert_limit, by = 'call_area') %>% dplyr::group_by(call_area_label) %>% dplyr::summarise(complaints = sum(complaints), alert_limit = mean(alert_limit)) %>% dplyr::mutate(complaints = replace(complaints, is.na(complaints), 0), review = ifelse(complaints >= alert_limit, 'Review', 'Pass')) %>% dplyr::rename(call_area = call_area_label) %>% dplyr::select(call_area, review, alert_limit, complaints) systab <- tableGrob(systemic, row = NULL) inds <- (1:nrow(systemic))[systemic$review == 'Review'] for (i in inds) { ind <- find_cell(systab, i+1, 2, 'core-bg') systab$grobs[ind][[1]][['gp']] <- gpar(fill = '#ffb2b2', col = '#000000') } grid.draw(systab)
rbc_summary %>% dplyr::right_join(y = alert_limit, by = 'call_area') %>% dplyr::filter( call_area_label %in% systemic$call_area[systemic$review == 'Review'] ) %>% dplyr::group_by(call_area_label, week_start_date) %>% dplyr::summarise(complaints = sum(complaints)) %>% tidyr::nest() %>% dplyr::mutate( data = purrr::map( data, ~.x %>% dplyr::right_join(y = data.frame(week_start_date = dates), by = 'week_start_date') %>% dplyr::mutate(complaints = replace(complaints, is.na(complaints), 0), complaints = cumsum(complaints)) ) )%>% tidyr::unnest() %>% dplyr::left_join(y = alert_limit %>% dplyr::select(-call_area) %>% unique(), by = 'call_area_label') %>% ggplot(aes(x = week_start_date, y = complaints)) + geom_point() + geom_line(group = 1) + geom_text_repel(aes(label = complaints)) + scale_x_datetime(breaks = dates) + geom_hline(aes(yintercept = alert_limit), linetype = 'dashed', color = 'red') + facet_wrap(~call_area_label, ncol = 1) + labs(title = 'Cumulative Count of Complaints by Week', y = 'Cumulative Complaint Count') + theme(axis.title.x = element_blank(), axis.text.x = element_text(angle = 90, hjust = 1, vjust = .5), panel.grid.minor.x = element_blank(), panel.grid.minor.y = element_blank())
DT::datatable( rbc_summary %>% dplyr::right_join(y = alert_limit, by = 'call_area') %>% dplyr::filter( call_area_label %in% systemic$call_area[systemic$review == 'Review'] ) %>% dplyr::group_by(call_area_label, lot_serial_number) %>% dplyr::summarise(complaints = sum(complaints)) %>% dplyr::arrange(call_area_label, -complaints) %>% dplyr::ungroup() %>% dplyr::mutate(call_area_label = as.factor(call_area_label), lot_serial_number = as.factor(lot_serial_number)), filter = 'top', selection = 'none', options = list(dom = 'ft', scrollY = '450px', paging = FALSE), rownames = FALSE )
DT::datatable( tm %>% dplyr::select(complaint_number, create_audit_date, call_subject, call_subject_desc, call_area, lot_serial_number, resolution, country_code) %>% dplyr::arrange(as.numeric(complaint_number)) %>% dplyr::mutate(create_audit_date = strftime(create_audit_date, format = '%F %T')) %>% dplyr::mutate_all(dplyr::funs(as.factor)) %>% dplyr::mutate(create_audit_date = as.character(create_audit_date)), filter = 'top', rownames = FALSE )
grouped <- tm %>% dplyr::group_by(call_subject_desc, lot_serial_number, call_area) %>% dplyr::summarise(complaints = n()) %>% dplyr::ungroup() %>% dplyr::mutate_if(is.character, dplyr::funs(as.factor)) DT::datatable(grouped, filter = 'top', rownames = FALSE)
DT::datatable( tm %>% dplyr::select(complaint_number, call_subject, call_subject_desc, call_area, lot_serial_number, problem_desc) %>% dplyr::mutate(problem_desc = gsub('\\\r\\\n', '<br/>', problem_desc)) %>% dplyr::mutate_all(dplyr::funs(as.factor)) %>% dplyr::mutate(problem_desc = as.character(problem_desc)), filter = 'top', rownames = FALSE, escape = FALSE )
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.