R/x600_updater.R

#' @title x600_updater
#'
#' @description Adds and appends most recent quarter's complaint and x600 metric data
#' to respective tables in srms db.
#'
#' @param so_filepath Filepath to Excel Workbook containing x600 Service Order Metrics
#' @param ib_filepath Filepath to install base trending file.
#' @param insert Bool to indicated whether to insert into srms db. Defaults to TRUE.
#'
#' @return Appends data to x600_complaints and x600_program_metrics tables in srms db.
#' Invisibly returns list of dataframes if function call is assigned to value.
#'
#' @export
x600_updater <- function(
  so_filepath,
  ib_filepath,
  insert = TRUE
) {

  complaints <- srms::roc_eq_v26b() %>%
    dplyr::mutate(
      dummy_date = as.POSIXct(
        strptime(paste0(YYYYMM, '01'), format = '%Y%m%d')
      ),
      quarter = paste0(lubridate::year(dummy_date),
                       paste0('Q', lubridate::quarter(dummy_date)))
    ) %>%
    dplyr::filter(quarter == max(quarter))

  modules <- srms::srms_table('x600_modules') %>%
    split(.$module)

  # set analyzers of interest for each module to sum correct installbase numbers
  analyzers <- vector('list', length(modules)) %>% setNames(names(modules))

  analyzers$`MicroSlide Incubator` <- c('FS 4600 SYS', '5600')
  analyzers$`MicroWell Wash - Volume` <- c('3600', '5600')
  analyzers$`SB5-010 System Timeouts` <- c('3600', 'FS 4600 SYS', '5600')
  analyzers$`MicroWell Incubator` <- c('3600', '5600')
  analyzers$`MicroSlide Insert Blades` <- c('FS 4600 SYS', '5600', 'FS')
  analyzers$`Compressor` <- c('3600', '5600')
  analyzers$`MicroWell Wash - Thermal` <- c('3600', 'FS 4600 SYS', '5600', 'FS')

  ib <- srms::ib_trending_parser(filepath = ib_filepath,
                                 type = 'WW') %>%
    dplyr::ungroup() %>%
    dplyr::filter(Region == 'GLOBAL') %>%
    dplyr::mutate(
      dummy_date = as.POSIXct(
        strptime(paste0(YYYYMM, '01'), format = '%Y%m%d')
      ),
      quarter = paste0(lubridate::year(dummy_date),
                       paste0('Q', lubridate::quarter(dummy_date)))
    ) %>%
    dplyr::group_by(Equipment, quarter) %>%
    dplyr::summarise(installbase = installbase[dummy_date == max(dummy_date)])

  ib_each <- purrr::map(
    .x = analyzers,
    .f = ~ ib %>%
      dplyr::filter(Equipment %in% .x) %>%
      dplyr::group_by(quarter) %>%
      dplyr::summarise(installbase = sum(installbase))
  )

  complaints_each <- purrr::map(
    .x = analyzers,
    .f = ~ complaints %>%
      dplyr::filter(Family_Code %in% .x) %>%
      dplyr::group_by(quarter, Call_Subject) %>%
      dplyr::summarise(complaints = n())
  )

  normalized_complaints <- vector('list', length(modules)) %>%
    setNames(names(modules))

  for (mod in names(modules)) {
    normalized_complaints[[mod]] <- modules[[mod]] %>%
      dplyr::left_join(
        y = complaints_each[[mod]],
        by = c('call_subject' = 'Call_Subject')
      ) %>%
      dplyr::arrange(quarter) %>%
      dplyr::mutate(quarter = zoo::na.locf(quarter),
                    complaints = replace(complaints, is.na(complaints), 0)) %>%
      dplyr::group_by(module, quarter) %>%
      dplyr::summarise(complaints = sum(complaints)) %>%
      dplyr::left_join(
        y = ib_each[[mod]],
        by = 'quarter'
      ) %>%
      dplyr::mutate(complaint_rate = complaints / installbase)
  }

  complaints_summary <- normalized_complaints %>% dplyr::bind_rows()

  barnes_names <- c('uS Incubator', 'Well Wash Volume', 'Well Wash Thermal',
                    'uWell Incubator', 'uS Insert Blades', 'Compressor',
                    'SB5-010 Timeouts')

  program_metrics <- lapply(
    barnes_names,
    function(x)
      openxlsx::read.xlsx(xlsxFile = so_filepath,
                          sheet = x,
                          startRow = 2)
  ) %>%
    setNames(barnes_names)

  inds <- lapply(
    program_metrics,
    function(x)
      length(names(x)) - match('Cost', rev(names(x))) + 1
  )

  program_metrics %<>%
    purrr::map2(
      .x = .,
      .y = inds,
      .f = ~ .x[c(1, .y:ncol(.x))] %>%
        dplyr::mutate_each(dplyr::funs(replace(., is.na(.), 0))) %>%
        dplyr::rename(YYYYMM = X1) %>%
        dplyr::mutate(
          dummy_date = as.POSIXct(
            strptime(paste0(YYYYMM, '01'), format = '%Y%m%d')
          ),
          quarter = paste0(lubridate::year(dummy_date),
                           paste0('Q', lubridate::quarter(dummy_date)))
        ) %>%
        dplyr::group_by(quarter) %>%
        dplyr::summarise_each(dplyr::funs(.[dummy_date == max(dummy_date)])) %>%
        tidyr::gather(mod, implemented, (1:ncol(.))[grepl('Mod', names(.))]) %>%
        dplyr::mutate(mod = stringr::str_extract(mod, 'Mod.[0-9]{2}')) %>%
        dplyr::select(-YYYYMM, -dummy_date)
    ) %>%
    setNames(barnes_names %>%
               gsub('uS', 'MicroSlide', .) %>%
               gsub('Well Wash ', 'MicroWell Wash - ', .) %>%
               gsub('uWell', 'MicroWell', .) %>%
               gsub('Timeouts' , 'System Timeouts', .)) %>%
    purrr::map2_df(
      .x = .,
      .y = names(.),
      .f = ~ .x %>%
        dplyr::mutate(module = .y)
    ) %>%
    dplyr::filter(quarter == max(quarter))

  if (insert) {
    srms::srms_insert(table = 'x600_complaints',
                      df = complaints_summary %>% dplyr::ungroup(),
                      append = TRUE)
    srms::srms_insert(table = 'x600_program_metrics',
                      df = program_metrics,
                      append = TRUE)
  }

  invisible(list(x600_complaints = complaints_summary,
                 x600_metrics = program_metrics))
}
kimjam/srms documentation built on May 20, 2019, 10:21 p.m.