inst/shiny-dashboards/cohort_reviewer/server.R

In JayAchar/tbreportr: Tools for Reporting TB Data

#
# This is a Shiny web application. You can run the application by clicking
# the 'Run App' button above.


library(shiny)
library(ggplot2)
library(dplyr)
library(ggthemes)
library(DT)
library(tbcleanr)
library(forcats)
library(tidyr)

# Define server logic required to draw a histogram
server <- function(input, output) {
  
 # allow large file sizes to be uploaded
  options(shiny.maxRequestSize=100*1024^2) 

  
  # uploaded file
  uploaded_file <- reactive({
    req(input$file)
    readr::read_csv(input$file$datapath, guess_max = 100000) %>% 
      tbcleanr::adm_data_cleanr() %>% 
      tbgeneratr::adm_generator(categorise = TRUE,
                                paediatric = TRUE) %>% 
      adm_var_renamer() %>% 
      mutate(simple_dst = case_when(as.numeric(recorded_dst) %in% 1:3 ~ "DSTB",
                                    as.numeric(recorded_dst) %in% 4:5 ~ "DRTB",
                                    TRUE ~ NA_character_)) %>%
      mutate(start_month = month.name[start_month])
  })
  
  # UI for filtering years
  output$year_filter <- renderUI({
    dates <- uploaded_file()$start_year
    min_yr <- min(dates, na.rm = TRUE)
    max_yr <- max(dates, na.rm = TRUE)
    numericInput("filter_year",
                 label = "Choose year:",
                 min = min_yr,
                 max = max_yr,
                 value = max_yr)
  })
  
  
  
  
    # for conditionalPanel in UI
  output$fileUploaded <- reactive({
    return(!is.null(uploaded_file()))
  })
  
  outputOptions(output, 'fileUploaded', suspendWhenHidden=FALSE)
  


  # generate text defining most recent starttre
  output$dbtime <- renderText({
    paste0("The most recent patient starting treamtent in this data is: ", 
           uploaded_file() %>% 
             pull(start_dt) %>% 
             max(na.rm = TRUE))
  })

  # time filter df
  df_time_filtered <- reactive({
    req(input$filter_month)
    if ("All" %in% input$filter_month) {
      uploaded_file() %>%
        filter(start_year == input$filter_year)
    } else {
      uploaded_file() %>%
      filter(start_year == input$filter_year) %>%
      filter(start_month %in% input$filter_month)
    }
  })


  # barplot of admission by time range and DST
  output$inclusion_plot <- renderPlot({
    df_time_filtered() %>%
      count(recorded_dst) %>%
      ggplot(aes(x = recorded_dst, y = n)) +
      geom_col() +
      labs(title = paste0("Cohort admission between "),
           x = "Clinician derived DST",
           y = "Cohort admission count")
  })


  # data table of admission counts
  output$inclusion_table <- DT::renderDataTable({
    df_time_filtered() %>% count(recorded_dst) %>%
    DT::datatable(options = list(searching = FALSE,
                                 paging = FALSE),
                  rownames = FALSE)
  })

  # plot of age per DST
  output$age_dst <- renderPlot({
    df_time_filtered() %>%
      filter(!is.na(simple_dst)) %>%
      ggplot(aes(x = age_years, fill = simple_dst)) +
      geom_density(alpha = 0.4)
  })

  # data table of age per DST
  output$age_dst_dt <- DT::renderDataTable({
    df_time_filtered() %>%
      filter(!is.na(simple_dst)) %>%
      count(simple_dst, age_cat) %>%
      tidyr::complete(age_cat, simple_dst) %>%
      tidyr::spread(simple_dst, n, fill = 0L) %>%
      select(age_cat, DSTB, DRTB) %>%
      DT::datatable(options = list(searching = FALSE,
                                   paging = FALSE),
                    rownames = FALSE)
  })

  # plot cohort inclusion by district
  output$inclusion_district_plot <- renderPlot({
    df_time_filtered() %>%
      filter(!is.na(district)) %>%
      count(district, simple_dst) %>%
      group_by(district) %>%
      mutate(total = sum(n)) %>%
      ggplot(aes(x = fct_reorder(district, total), y = n, fill = simple_dst)) +
      geom_bar(stat = 'identity', width = 0.7) +
      coord_flip()
  })


}