In kimjam/srms: Package to automate tasks and reporting for OCD SRMS Team.

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))

Lots for Review {data-navmenu='Page'}

Row {.tabset .tabset-fade}

Call Areas for Review

grid.draw(qrcutils::merge_rows(df = rbc_cs, n = 1))

Cumulative Complaints by Week

  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())

Complaints by Resolution

grid.draw(qrcutils::merge_rows(df = rbc_res, n = 1))

Complaints by Country

grid.draw(qrcutils::merge_rows(df = rbc_country, n = 1))

Systemic Issues {data-navmenu='Page' data-orientation=columns}

Column {.tabset .tabset-fade data-width=600}

Systemic Issues Trending

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)

Systemic Issue Cumulative Complaints by Week

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())

Column {data-width=400}

Complaints by Lot

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
)

Raw Complaint Data {data-navmenu='Page'}

Raw Complaint Data

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
)

Call Subject-Lot-Call Area Counts {data-navmenu='Page'}

Complaints by Call Subject-Lot-Call Area

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)

Problem Description Viewer {data-navmenu='Page'}

Problem Description Viewer

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
)

kimjam/srms documentation built on May 20, 2019, 10:21 p.m.