inst/pcdtest/server.R

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

library(shiny)
library(rpivotTable)

server <- function(input, output) {
  # load raw data
  df <- srms::roc_re_v26b() %>%
    dplyr::select(-Startdate, -End_Date)

  cust_names <- srms::pcd_query(
    query = 'select distinct eq_loc_cus_wt, eq_cust_name from B545PCD.dbo.t545equip'
  ) %>% srms::df_checker()

  call_subjs <- df %>%
    dplyr::group_by(Call_Subject) %>%
    dplyr::summarise(count = n()) %>%
    dplyr::arrange(-count) %>%
    .$Call_Subject

  # complaints by technology section
  output$bytechtab <- DT::renderDataTable({
    bytech <- df %>%
      srms::add_clre_tech(., write = FALSE) %>%
      dplyr::group_by(
        Technology,
        YYYYMM
      ) %>%
      dplyr::summarise(
        count = n()
      ) %>%
      reshape2::dcast(., Technology ~ YYYYMM, value.var = 'count')

    coloring <- t(apply(bytech[2:14], 1, scale)) %>% as.data.frame()
    names(coloring) <- paste0(names(bytech)[2:14], '_color')

    yearmon <- as.POSIXct(
      paste0(names(bytech)[2:ncol(bytech)], '01'),
      format = '%Y%m%d'
    )
    prettynames <- paste(
      lubridate::month(yearmon, label = TRUE),
      lubridate::year(yearmon)
    )

    names(bytech)[2:ncol(bytech)] <- prettynames
    DT::datatable(
      cbind(bytech, coloring),
      options = list(searching = FALSE, paging = FALSE, bInfo = FALSE,
                     columnDefs = list(list(visible = FALSE, targets = 15:27)))
    ) %>%
      DT::formatStyle(
        columns = 2:14,
        valueColumns = 15:27,
        target = 'cell',
        backgroundColor = DT::styleInterval(c(-2, -1.5, -1, -.5,
                                              0, .5, 1, 1.5, 2),
                                            c('#198c19', '#4ca64c', '#7fbf7f',
                                              '#b2d8b2', '#e5f2e5', '#ffe5e5',
                                              '#ffb2b2', '#ff7f7f', '#ff4c4c',
                                              '#ff1919'))
      )
  })

  techlinesInput <- reactive({
    techplot <- df %>%
      srms::add_clre_tech(., write = FALSE) %>%
      dplyr::mutate(
        YYYYMM = factor(YYYYMM, levels = sort(unique(YYYYMM)))
      ) %>%
      dplyr::group_by(
        Technology,
        YYYYMM
      ) %>%
      dplyr::summarise(
        count = n()
      )

    yearmon <- as.POSIXct(
      paste0(sort(unique(techplot$YYYYMM)), '01'),
      format = '%Y%m%d'
    )
    prettynames <- paste0(
      lubridate::month(yearmon, label = TRUE),
      '-',
      lubridate::year(yearmon)
    )
    ggplot(
      techplot,
      aes(x = YYYYMM, y = count, color = Technology, group = Technology)
    ) +
      geom_line() +
      geom_point() +
      geom_text(aes(label = count), vjust = -1) +
      scale_y_continuous(
        limits = c(min(techplot$count) - 20, max(techplot$count) + 20)
      ) +
      scale_x_discrete(
        labels = prettynames
      ) +
      labs(
        title = 'Complaints by Technology, Past 13 Months',
        x = 'Month-Year',
        y = 'Count of Complaints'
      )
  })

  output$bytechlines <- renderPlot({
    techlinesInput()
  })

  output$dltechlines <- downloadHandler(
    filename = 'complaints_by_tech.png',
    content = function(file) {
      ggsave(file, techlinesInput(), width = 12)
    }
  )

  # customers section
  customerInput <- reactive({
    df %>%
      dplyr::filter(
        YYYYMM == input$custdate
      ) %>%
      dplyr::left_join(
        y = cust_names,
        by = c('Customer_Number' = 'eq_loc_cus_wt')
      ) %>%
      dplyr::group_by(
        Complaint_Nbr___CH
      ) %>%
      dplyr::mutate(
        Customer_Name = eq_cust_name[1]
      ) %>%
      dplyr::select(
        -eq_cust_name
      ) %>%
      dplyr::filter(
        row_number() == 1
      ) %>%
      dplyr::ungroup() %>%
      dplyr::group_by(
        Customer_Number,
        Customer_Name
      ) %>%
      dplyr::summarize(
        Complaints = n()
      ) %>%
      dplyr::ungroup() %>%
      dplyr::arrange(
        -Complaints
      ) %>%
      head(input$topcust)
  })

  output$customers <- renderTable({
    customerInput()
  })

  output$dlcustomers <- downloadHandler(
    filename = function() {
      paste0(
        'top', input$topcust, '_customers.',
        switch(input$custfiletype, .xlsx = 'xlsx', .csv = 'csv')
      )
    },
    content = function(file) {
      switch(
        input$custfiletype,
        .xlsx = openxlsx::write.xlsx(x = customerInput(), file),
        .csv = write.csv(x = customerInput(), file, row.names = FALSE)
      )
    }
  )

  # reagents section
  reagentInput <- reactive({
    df %>%
      dplyr::filter(
        YYYYMM == input$reagdate
      ) %>%
      dplyr::group_by(
        Call_Subject
      ) %>%
      dplyr::summarize(
        Complaints = n()
      ) %>%
      dplyr::ungroup() %>%
      dplyr::arrange(
        -Complaints
      ) %>%
      dplyr::mutate(
        Cumulative_Percentage = paste0(
          round(cumsum(Complaints) / sum(Complaints) * 100, digits = 1), '%'
        )
      ) %>%
      head(input$topreag)
  })

  output$reagents <- renderTable({
    reagentInput()
  })

  output$dlreagents <- downloadHandler(
    filename = function() {
      paste0(
        'top', input$topreag, '_reagents.',
        switch(input$reagfiletype, .xlsx = 'xlsx', .csv = 'csv')
      )
    },
    content = function(file) {
      switch(
        input$reagfiletype,
        .xlsx = openxlsx::write.xlsx(x = reagentInput(), file),
        .csv = write.csv(x = reagentInput(), file, row.names = FALSE)
      )
    }
  )

  # pareto section
  paretoInput <- reactive({
    srms::ggpareto(
      df = df,
      filter = paste0('Call_Subject == "',
                      input$callsubject,
                      '" & YYYYMM == ',
                      input$date)
    )$plot
  })

  output$pareto <- renderPlot({
    paretoInput()
  })

  output$callsubject <- renderUI({
    selectInput('callsubject', 'Call Subject', call_subjs)
  })

  output$dlpareto <- downloadHandler(
    filename = function() {
      paste0(input$callsubject, '_pareto', input$date, '.png')
    },
    content = function(file) {
      ggsave(file, paretoInput(), width = 12)
    }
  )

  rawparetoInput <- reactive({
    srms::ggpareto(
      df = df,
      filter = paste0('Call_Subject == "',
                      input$callsubject,
                      '" & YYYYMM == ',
                      input$date)
    )$data %>%
      dplyr::mutate(
        Call_Area = modality,
        Complaints = frequency,
        Cumulative_Percentage = paste0(round(cumperc, digits = 1), '%')
      ) %>%
      dplyr::select(
        Call_Area,
        Complaints,
        Cumulative_Percentage
      )
  })

  output$rawpareto <- renderTable({
    rawparetoInput()
  })

  output$dlparraw <- downloadHandler(
    file = function() {
      paste0(
        input$callsubject, '_pareto_raw_', input$date,
        switch(input$parfiletype, .xlsx = '.xlsx', .csv = '.csv')
      )
    },
    content = function(file) {
      switch(
        input$parfiletype,
        .xlsx = openxlsx::write.xlsx(x = rawparetoInput(), file),
        .csv = write.csv(x = rawparetoInput(), file, row.names = FALSE)
      )
    }
  )

  # control chart section
  ccInput <- reactive({
    ccdf <- srms::ggcc_preprocess(
      df = df,
      filter_str = paste0('Call_Subject == "', input$callsubject2, '"')
    )

    grid.arrange(ggcc(ccdf, input$callsubject2))
  })

  output$callsubject2 <- renderUI({
    selectInput('callsubject2', 'Call Subject', call_subjs)
  })
  output$controlchart <- renderPlot({
    ccInput()
  })

  output$dlcc <- downloadHandler(
    file = function() {
      paste0(input$callsubject2, '_controlchart.png')
    },
    content = function(file) {
      ggsave(
        file, ccInput(), width = 12
      )
    }
  )

  # pivot table
  output$pivottable <- renderRpivotTable({
    rpivotTable(data = df, menuLimit = 700)
  })

  # raw data output
  rawdataInput <- reactive({
    rawdf <- df
    names(rawdf)[1:7] <- c('YYYYMM', 'Analyzer', 'Family_Code',
                           'Product_Number', 'Call_Subject', 'Call_Area',
                           'Complaint_Nbr')

    # names(rawdf)[(ncol(rawdf)-1):ncol(rawdf)] <- c('startdate', 'enddate')

    rawdf[sapply(rawdf, class) %in% c('numeric', 'integer')] <- lapply(
      rawdf[sapply(rawdf, class) %in% c('numeric', 'integer')], factor)

    rawdf$Call_Subject <- factor(rawdf$Call_Subject)
    rawdf$Call_Area <- factor(rawdf$Call_Area)
    rawdf %<>%
      dplyr::select(
        -Device_Count
      )
    return(rawdf)
  })

  output$rawdf <- DT::renderDataTable(
    rawdataInput(), filter = 'top', server = FALSE, selection = 'none'
  )

  output$dlrawdata <- downloadHandler(
    filename = function() {
      paste0(
        'rawdata.', switch(input$rawdatafiletype, .xlsx = 'xlsx', .csv = 'csv')
      )
    },
    content = function(file) {
      s = input$rawdf_rows_all
      switch(
        input$rawdatafiletype,
        .xlsx = openxlsx::write.xlsx(x = rawdataInput()[s, , drop = FALSE ], file),
        .csv = write.csv(x = rawdataInput()[s, , drop = FALSE ], file,
                         row.names = FALSE)
      )
    }
  )
}