inst/waittimeapp/server.R

In jlewis91/datascience: Set of useful functions and sometime reports. :)

library(data.table)
library(taucharts)

# addl_hours_weekday, addl_hours_weekend

shinyServer(function(input, output, session) {
  n26_colors <- c("#7c260b", "#76c0c1", "#6794a7", "#014d64", "#01a2d9")
  date_range = ""
  convDF <- fread("twitterDF.csv")
  convDF[, created_usertweet := as.POSIXct(created_usertweet)]

  processTimeofDayData <- reactive({
    target_wait_time <- input$target_wait_time
    date_range <- input$date_range
    wait_time_df <- convDF[created_usertweet >= date_range,
                           .(Excess.Wait = (median(response_time[response_time > target_wait_time]) - target_wait_time) *
                                 sum(response_time > target_wait_time)  / 60,
                  late_response_count = sum(response_time > target_wait_time),
                  volume = length(response_time)),
       by = .(hour, Weekday, Time.of.Day = paste0(hour, ":00"))]
    wait_time_df[, Weekday := factor(Weekday, levels = c("Sun", "Sat", "Fri", "Thurs", "Wed", "Tues", "Mon"),
                                     ordered = TRUE)]
    wait_time_df[, Excess.Waiting.Time := paste(round(Excess.Wait, 0), "hours")]
    return(wait_time_df)
  })

  processPerformanceHistoryData <- reactive({
    target_wait_time <- input$target_wait_time
    date_range <- input$date_range
    performancePct <- convDF[created_usertweet >= as.POSIXct(date_range),
                             .(Ontime.Response.Pct_num = round(100*mean(response_time <= target_wait_time), 1),
                               ontime_response_count = sum(response_time <= target_wait_time),
                               late_response_count = sum(response_time > target_wait_time),
                                   sum(response_time > target_wait_time)  / 60
                               ),
       by = .(created_usertweet = lubridate::floor_date(created_usertweet, "week"))]
    performancePct[, Ontime.Response.Percent := paste0(Ontime.Response.Pct_num, "%")]
    return(performancePct)
  })

  # wait_time_df <- processTimeofDayData()
  # performancePct <- processPerformanceHistoryData()
  output$people_served <- renderText({
      performancePct <- processPerformanceHistoryData()
      performancePct[, sum(ontime_response_count)]
  })

  output$pct_served <- renderText({
    performancePct <- processPerformanceHistoryData()
    performancePct[, round(100*sum(ontime_response_count) / (sum(ontime_response_count) + sum(late_response_count)))]
  })

  output$people_waiting <- renderText({
    performancePct <- processPerformanceHistoryData()
    people_waiting <- performancePct[, sum(late_response_count)]
  })

  output$time_waited <- renderText({
    wait_time_df <- processTimeofDayData()
    time_waited <- wait_time_df[, sum(Excess.Wait, na.rm = TRUE) %>% round() %>% format(big.mark = ",")]
  })

  output$additional_people_served_intervention <- renderText({
    performancePct <- processPerformanceHistoryData()
    people_waiting <- performancePct[, sum(late_response_count)]

    wait_time_df <- processTimeofDayData()
    scenario_data <- wait_time_df[!(Weekday %in% c("Sat", "Sun") &
                                    hour < max(input$addl_hours_weekend) &
                                    hour >= min(input$addl_hours_weekend)) &
                                    !(!Weekday %in% c("Sat", "Sun") &
                                    hour < max(input$addl_hours_weekday) &
                                    hour >= min(input$addl_hours_weekday)),]
    people_waiting - scenario_data[, sum(late_response_count)]
  })

  output$less_time_waiting_intervention <- renderText({
    wait_time_df <- processTimeofDayData()
    time_waited <- wait_time_df[, sum(Excess.Wait, na.rm = TRUE)]

    scenario_data <- wait_time_df[!(Weekday %in% c("Sat", "Sun") &
                                    hour < max(input$addl_hours_weekend) &
                                    hour >= min(input$addl_hours_weekend)) &
                                    !(!Weekday %in% c("Sat", "Sun") &
                                    hour < max(input$addl_hours_weekday) &
                                    hour >= min(input$addl_hours_weekday)),]
    (time_waited - scenario_data[, sum(Excess.Wait, na.rm = TRUE)]) %>% round() %>% format(big.mark = ",")
  })


  output$plot1 <- taucharts::renderTaucharts({
    wait_time_df <- processTimeofDayData()
    tauchart(wait_time_df, width = "600px", height = "400px") %>%
      tau_bar("hour", c("Weekday", "Excess.Wait")) %>%
      tau_tooltip(c("Weekday", "Time.of.Day", "Excess.Waiting.Time")) %>%
      tau_guide_x(max = "24", auto_scale = FALSE) %>%
      tau_add_css_rule("{{ID}} .graphical-report__svg .color20-1{fill:#76c0c1; stroke:#76c0c1;}")
  })
  output$plot2 <- taucharts::renderTaucharts({
    performancePct <- processPerformanceHistoryData()
    tauchart(performancePct, width = "600px", height = "300px") %>%
      tau_line("created_usertweet", "Ontime.Response.Pct_num") %>%
      tau_tooltip(c("created_usertweet", "Ontime.Response.Percent")) %>%
      tau_guide_y(label = "Percent On-time Response") %>%
      tau_guide_x(label = "Date", tick_format = "%Y.%m.%d") %>%
      tau_color_manual(values = rep(n26_colors[2], 5))
  })


})