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

knitr::opts_chunk$set(fig.width = 8)

join_region <- . %>% 
  dplyr::left_join(y = countries %>% 
                     dplyr::select(Region,
                                   Country_Code),
                   by = 'Country_Code') %>%
  dplyr::mutate(
    Region = dplyr::case_when(
      .$Country_Code == 'CA' ~ 'CANADA',
      .$Country_Code == 'CH' ~ 'CHINA',
      .$Country_Code == 'JP' ~ 'JAPAN',
      .$Country_Code == 'IN' ~ 'INDIA',
      TRUE ~ .$Region
    )
  ) %>%
  split(.$Region)

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

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

row_heat_table <- . %>%
  tableGrob(
    row = NULL,
    theme = ttheme_default(
      core = list(fg_params = list(cex = .5),
                  bg_params = list(fill = get_row_bg(.))),
      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)#, 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 = 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)
}

region_summary <- function(region) {

  if (region == 'GLOBAL') { 
    tablist <- list(CLRE = clre %>% dplyr::bind_rows(),
                    CLEQ = cleq %>% dplyr::bind_rows(),
                    TMRE = tmre %>% dplyr::bind_rows(),
                    TMEQ = tmeq %>% dplyr::bind_rows())
  } else { 
    tablist <- list(CLRE = clre[[region]],
                    CLEQ = cleq[[region]],
                    TMRE = tmre[[region]],
                    TMEQ = tmeq[[region]])
  }

  grouper <- function(df) {
    grouped <- data.frame(
      YYYYMM = strftime(c(Sys.time()-months(13:2), last_month()), format = '%Y%m'),
      stringsAsFactors = FALSE
    ) %>%
      dplyr::left_join(
        y = df %>%
          dplyr::group_by(YYYYMM) %>%
          dplyr::summarise(complaints = n()),
        by = 'YYYYMM'
      ) %>%
      dplyr::mutate(complaints = replace(complaints, is.na(complaints), 0))

    return(grouped)
  }

  df <- lapply(tablist, grouper) %>%
    dplyr::bind_rows() %>%
    dplyr::mutate(Type = rep(names(tablist), each = 13),
                  complaints = replace(complaints, is.na(complaints), 0))

  df_wide <- df %>%
    tidyr::spread(key = YYYYMM, value = complaints, fill = 0) %>%
    srms::add_margins() %>%
    dplyr::select(-Total) %>%
    row_heat_table()

  plot <- ggplotGrob(
    ggplot(df, 
           aes(x = YYYYMM, y = complaints, 
               group = Type, color = Type)) + 
      geom_point() +
      # geom_text(aes(label = complaints), 
      #           size = 3,
      #           hjust = 'inward', vjust = 'inward') +
      geom_line() +
      labs(title = paste(region, 'Complaint Summary')) +
      theme(legend.position = 'top',
            axis.title.x = element_blank(),
            legend.text = element_text(size = 7),
            text = element_text(size = 8)) +
      scale_color_tableau()
  )

  grob_binder(ggrob = plot, tgrob = df_wide)
}

clre_summary <- function(region) {

  if (region == 'GLOBAL') {
    df <- clre %>% 
      dplyr::bind_rows() %>% 
      srms::add_clre_tech(write = FALSE)
  } else { 
    df <- clre[[region]] %>% 
      srms::add_clre_tech(write = FALSE)
  }

  bycs <- df %>%
    dplyr::filter(YYYYMM == max(YYYYMM)) %>%
    dplyr::group_by(Call_Subject) %>%
    dplyr::summarise(complaints = n()) %>%
    dplyr::arrange(-complaints) %>%
    dplyr::mutate(Cumulative_Percent_of_Total = round(cumsum(
      complaints / sum(complaints) * 100), 1))

  bytech <- df %>%
    dplyr::group_by(Technology, YYYYMM) %>%
    dplyr::summarise(complaints = n()) %>%
    tidyr::spread(key = YYYYMM, value = complaints, fill = 0) %>%
    srms::add_margins() %>%
    dplyr::select(-Total) %>%
    tidyr::gather(key = YYYYMM, value = complaints, -Technology)


  df_wide <- bytech %>%
    tidyr::spread(key = YYYYMM, value = complaints, fill = 0) %>%
    row_heat_table()

  plot <- ggplotGrob(
    ggplot(bytech,
           aes(x = YYYYMM, y = complaints, 
               group = Technology, color = Technology)) +
      geom_point() +
      # geom_text(aes(label = complaints),
      #           size = 3,
      #           hjust = 'inward', vjust = 'inward') +
      geom_line() +
      labs(title = paste(region, 'CLRE Complaints by Technology')) +
      theme(legend.position = 'top',
            axis.title.x = element_blank(),
            legend.text = element_text(size = 7),
            text = element_text(size = 8)) +
      scale_color_tableau()
  )

  return(list(bycs = bycs, 
              bytechtab = df_wide, 
              bytechplot = plot))
}

cleq_summary <- function(region) {

  if (region == 'GLOBAL') {
    df <- cleq %>% dplyr::bind_rows() %>% dplyr::mutate(Region = 'GLOBAL')
  } else {
    df <- cleq[[region]]
  }

  df %<>%
    dplyr::rename(Analyzer = Family_Code) %>%
    dplyr::left_join(
      y = ib,
      by = c('Region' = 'region', 'YYYYMM' = 'yyyymm', 'Analyzer' = 'analyzer')
    ) %>%
    dplyr::group_by(Analyzer, YYYYMM) %>%
    dplyr::summarise(complaints = n(),
                     ib = mean(installbase),
                     normalized = round(complaints / ib, 2)) %>%
    dplyr::arrange(-complaints)

  count_wide <- df %>% 
    dplyr::select(-ib, -normalized) %>% 
    tidyr::spread(key = YYYYMM, value = complaints, fill = 0) %>% 
    srms::add_margins() %>% 
    dplyr::select(-Total) %>%
    row_heat_table()

  normalized_wide <- df %>%
    dplyr::filter(!is.na(normalized)) %>%
    dplyr::select(-ib, -complaints) %>%
    tidyr::spread(key = YYYYMM, value = normalized, fill = 0) %>%
    row_heat_table()

  count_plot <- ggplotGrob(
    ggplot(df %>%
             dplyr::select(-ib, -normalized) %>% 
             tidyr::spread(key = YYYYMM, value = complaints, fill = 0) %>% 
             tidyr::gather(key = YYYYMM, value = complaints, -Analyzer),
           aes(x = YYYYMM, y = complaints, 
               group = Analyzer, color = Analyzer)) +
      geom_point() +
      # geom_text(aes(label = complaints),
      #           hjust = 'inward', vjust = 'inward') +
      geom_line() +
      labs(title = paste(region, 'CLEQ Complaints by Analyzer')) +
      theme(legend.position = 'top',
            axis.title.x = element_blank(),
            legend.text = element_text(size = 5),
            text = element_text(size = 5)) +
      scale_color_tableau()
  )

  normalized_plot <- ggplotGrob(
        ggplot(df %>%
                 dplyr::filter(!is.na(normalized)) %>%
                 dplyr::select(-ib, -complaints) %>% 
                 tidyr::spread(key = YYYYMM, value = normalized, fill = 0) %>% 
                 tidyr::gather(key = YYYYMM, value = normalized, -Analyzer),
               aes(x = YYYYMM, y = normalized, 
               group = Analyzer, color = Analyzer)) +
      geom_point() +
      # geom_text(aes(label = normalized),
      #           hjust = 'inward', vjust = 'inward') +
      geom_line() +
      labs(title = paste(region, 'CLEQ Normalized Complaints by Analyzer')) +
      theme(legend.position = 'top',
            axis.title.x = element_blank(),
            legend.text = element_text(size = 5),
            text = element_text(size = 5)) +
      scale_color_tableau()
  )

  return(list(counttab = count_wide,
              normtab = normalized_wide,
              countplot = count_plot,
              normplot = normalized_plot))
}

tmre_summary <- function(region) {

  if (region == 'GLOBAL') {
    x <- tmre %>% dplyr::bind_rows()
  } else {
    x <- tmre[[region]]
  }

  df <- x %>%
    dplyr::mutate(
      Group = dplyr::case_when(
        grepl('MT', .$Call_Subject) ~ 'MTS Reagent',
        .$Business_Unit_Desc == 'BLOOD SCREENING' ~ 'DONOR\nSCREENING',
        .$Business_Unit_Desc == 'IMMUNOHEMATOLOGY' ~ 'IH',
        TRUE ~ .$Business_Unit_Desc
      )
    ) %<>%
    dplyr::group_by(
      Group,
      YYYYMM
    ) %>%
    dplyr::summarise(complaints = n())

  tgrob <- data.frame(
    YYYYMM = strftime(c(Sys.time()-months(13:2), last_month()), format = '%Y%m'),
    Group = rep(unique(df$Group), each = 13),
    stringsAsFactors = FALSE
  ) %>%
    dplyr::left_join(y = df, by = c('YYYYMM', 'Group')) %>%
    tidyr::spread(key = YYYYMM, value = complaints, fill = 0) 

  df <- tgrob %>%
    tidyr::gather(key = YYYYMM, value = complaints, -Group)

  tgrob %<>%
    srms::add_margins() %>%
    dplyr::select(-Total) %>%
    row_heat_table()

  ggrob <- ggplotGrob(
    ggplot(df,
           aes(x = YYYYMM,
               y = complaints,
               color = Group, group = Group)) +
      geom_point() +
      geom_line() +
      labs(title = paste(region, 'TMRE Complaints by Group')) +
      theme(legend.position = 'top',
            axis.title.x = element_blank(),
            legend.text = element_text(size = 7),
            text = element_text(size = 8)) +
      scale_color_tableau()
  )

  bycs <- x %>%
    dplyr::filter(YYYYMM == max(YYYYMM)) %>% 
    dplyr::group_by(Call_Subject_Desc) %>% 
    dplyr::summarise(complaints = n()) %>% 
    dplyr::arrange(-complaints) %>%
    dplyr::mutate(Cumulative_Percent_of_Total = round(cumsum(
      complaints / sum(complaints) * 100), 1))

  return(list(bycs = bycs, t = tgrob, g = ggrob))
}

tmeq_summary <- function(region) {

  if (region == 'GLOBAL') {
    x <- tmeq %>% dplyr::bind_rows()
  } else {
    x <- tmeq[[region]]
  }
  df <- data.frame(
    YYYYMM = strftime(c(Sys.time()-months(13:2), last_month()), format = '%Y%m'),
    stringsAsFactors = FALSE
  ) %>%
    dplyr::left_join(
      y = x %>%
        dplyr::group_by(Analyzer, YYYYMM) %>%
        dplyr::summarise(complaints = n()),
      by = c('YYYYMM')
    )

  counttab <- df %>%
    tidyr::spread(key = YYYYMM, value = complaints, fill = 0) %>%
    split(.$Analyzer == 'Other') %>%
    dplyr::bind_rows() %>%
    srms::add_margins() %>%
    dplyr::select(-Total) %>%
    dplyr::mutate(Analyzer = replace(Analyzer, Analyzer == 'VISION MAX BV', 'VISION MAX\nBV')) %>%
    row_heat_table()

  countplot <- ggplotGrob(
    ggplot(df %>%
             tidyr::spread(key = YYYYMM, value = complaints, fill = 0) %>%
             tidyr::gather(key = YYYYMM, value = complaints, -Analyzer),
           aes(x = YYYYMM, y = complaints,
               color = Analyzer, group = Analyzer)) +
      geom_point() +
      geom_line() +
      labs(title = paste(region, 'TMEQ Complaints by Analyzer')) +
      theme(legend.position = 'top',
            axis.title.x = element_blank(),
            legend.text = element_text(size = 7),
            text = element_text(size = 8)) +
      scale_color_tableau()
  )

  normdf <- df %>%
    dplyr::filter(Analyzer != 'Other') %>%
    dplyr::mutate(Region = region) %>%
    dplyr::left_join(
      y = ib,
      by = c('Region' = 'region', 'YYYYMM' = 'yyyymm', 'Analyzer' = 'analyzer')
    ) %>%
    dplyr::mutate(normalized = round(complaints / installbase, 2)) %>%
    dplyr::select(-Region, -installbase, - complaints) %>%
    dplyr::filter(!is.na(normalized))

  normtab <- normdf %>%
    tidyr::spread(key = YYYYMM, value = normalized, fill = 0) %>%
    dplyr::mutate(Analyzer = replace(Analyzer, Analyzer == 'VISION MAX BV', 'VISION MAX\nBV')) %>%
    row_heat_table()

  normplot <- ggplotGrob(
    ggplot(normdf,
           aes(x = YYYYMM, y = normalized,
               group = Analyzer, color = Analyzer)) +
      geom_point() +
      geom_line() +
      labs(title = paste(region, 'TMEQ Normalized Complaints')) +
      theme(legend.position = 'top',
            axis.title.x = element_blank(),
            legend.text = element_text(size = 7),
            text = element_text(size = 8)) +
      scale_color_tableau()
  )

  return(list(counttab = counttab,
              countplot = countplot,
              normtab = normtab,
              normplot = normplot))
}

countries <- srms::srms_table('country_codes')

clre <- srms::roc_re_v26b(add = 'country') %>% 
  dplyr::filter(YYYYMM %in% head(sort(unique(YYYYMM)), 13)) %>%
  dplyr::mutate(YYYYMM = as.character(YYYYMM)) %>%
  join_region()
cleq <- srms::roc_eq_v26b(add = 'country') %>% 
  dplyr::filter(YYYYMM %in% head(sort(unique(YYYYMM)), 13)) %>%
  dplyr::mutate(YYYYMM = as.character(YYYYMM)) %>%
  join_region()
tm <- srms::tm_general_template() %>%
  dplyr::filter(Call_Subject != 'NONPROD') %>%
  dplyr::mutate(YYYYMM = strftime(Create_Audit_DT, format = '%Y%m'),
                Type = ifelse(Call_Type %in% c('CE', 'PHSE', 'CERE', 'CSW'),
                              'Instrument',
                              'Reagent'
                )
  ) %>%
  dplyr::filter(YYYYMM %in% head(sort(unique(YYYYMM)), 13)) %>%
  dplyr::left_join(
    y = tmrecat %>%
      dplyr::select(
        Dataset,
        Call.subject,
        Category
      ),
    by = c('Call_Subject' = 'Call.subject')
  ) %>%
  split(.$Type)

tmeq <- tm$Instrument %>% 
  dplyr::mutate(
    Analyzer = dplyr::case_when(
      .$Line_Desc %in% c('ORTHO SUMMIT PROCESSOR', 
                         'OSP 24/20 - Refurbished',
                         'Ortho Summis Process 24/20') ~ 'OSP',
      .$Prod_No_Desc %in% c('1585      AutoVue Innova',
                            '1588      AutoVue Ultra',
                            'SWINNOVA  AutoVue Innova Software',
                            'SWULTRA   AutoVue Ultra Software') ~ 'AUTOVUE IU',
      .$Line_Desc == 'MTS ProVue Analyzer' ~ 'PROVUE',
      .$Prod_No_Desc %in% c('6002      ORTHO VISION BV',
                            '6003      ORTHO VISION MAX BV') ~ 'VISION MAX BV',
      .$Prod_No_Desc %in% c('6904577   ORTHO VISION ID-MTS',
                            '6904576   ORTHO VISION MAX ID-MTS',
                            '5000      ORTHO VISION ID-MTS') ~ 'VISION MTS',
      .$Prod_No_Desc %in% c('SWVISION  Ortho Vision Software',
                            'SWVMAX    Ortho Vision Max Software') &
        .$Country_Code %in% c('CA', 'US') ~ 'VISION MTS',
      .$Prod_No_Desc %in% c('SWVISION  Ortho Vision Software',
                            'SWVMAX    Ortho Vision Max Software') ~ 'VISION MAX BV',
      TRUE ~ 'Other'
    )
  ) %>% join_region()
tmre <- tm$Reagent %>% join_region()

regions <- c('GLOBAL', 'NAR', 'EMEA', 'LAR', 'ASPAC', 'CHINA', 'JAPAN', 'CANADA', 'INDIA')

ib <- qrc_query(db = 'qrc_raw', query = 'SELECT * FROM installbase;') %>%
  dplyr::mutate(region = dplyr::case_when(
    .$country == 'INDIA' ~ 'INDIA',
    .$country == 'CANADA' ~ 'CANADA',
    TRUE ~ .$region
  )) %>%
  dplyr::group_by(region, yyyymm, analyzer) %>%
  dplyr::summarise(installbase = sum(installbase))

out <- NULL
for (region in regions) {
  out <- c(
    out,
    knitr::knit_expand(
      text = paste0(
        '\n{{region}} {data-navmenu=\'Region\'}',
        '\n=====================================\n',
        '\nColumn {.tabset .tabset-fade}',
        '\n-------------------------------------',
        '\n\n### Overall Summary',
        '\n```r}-summ}',
        '\nregion_summary(\'{{region}}\')',
        '\n```',
        '\n\n### CLRE Summary',
        '\n```r}-clre}',
        '\nviz <- clre_summary(\'{{region}}\')',
        '\ngrob_binder(ggrob = viz$bytechplot, tgrob = viz$bytechtab)',
        '\n```',
        '\n\n### CLRE Complaints by Call Subject',
        '\n```r}-clrecs}',
        '\nmake_basic_table(viz$bycs)',
        '\n```',
        '\n\n### CLEQ Complaints',
        '\n```r}-cleq}',
        '\nviz <- cleq_summary(\'{{region}}\')',
        '\ngrob_binder(ggrob = viz$countplot, tgrob = viz$counttab)',
        '\n```',
        '\n\n### CLEQ Normalized Complaints',
        '\n```r}-cleqnorm}',
        '\ngrob_binder(ggrob = viz$normplot, tgrob = viz$normtab)',
        '\n```',
        '\n\n### TMRE Summary',
        '\n```r}-tmre}',
        '\nviz <- tmre_summary(\'{{region}}\')',
        '\ngrob_binder(tgrob = viz$t, ggrob = viz$g)',
        '\n```',
        '\n\n### TMRE Compaints by Call Subject',
        '\n```r}-tmrecs}',
        '\nmake_basic_table(viz$bycs)',
        '\n```',
        '\n\n### TMEQ Complaints',
        '\n```r}-tmeq}',
        '\nviz <- tmeq_summary(\'{{region}}\')',
        '\ngrob_binder(tgrob = viz$counttab, ggrob = viz$countplot)',
        '\n```',
        '\n\n### TMEQ Normalized Complaints',
        '\n```r}-tmeqnorm}',
        '\ngrob_binder(tgrob = viz$normtab, ggrob = viz$normplot)',
        '\n```'
      ),
      region = region
    )
  )
}