Merge pull request #16 from The-Strategy-Unit/main

Changes made on main inadvertantly need merging with this development branch

archive/app.R

@@ -0,0 +1,280 @@
+#' -----------------------------------------------------------------------------
+#' WEBINAR STATS APP
+#' 
+#' Here is the Shiny code to control the ui and logic for the WebinarStats app
+#' -----------------------------------------------------------------------------
+
+# libraries --------------------------------------------------------------------
+library(shiny)
+library(tidyverse)
+library(readr)
+library(lubridate)
+library(stringr)
+library(shinyTime)
+#library(flexdashboard)
+library(clock)
+library(shinydashboard)
+
+## user-defined functions ----
+source("functions_script.R")
+
+# ui ---------------------------------------------------------------------------
+
+
+ui_mainpanel <- mainPanel(
+ # file
+ tableOutput("file"),
+ textOutput("number_of_attendees"),
+ textOutput("averagetime"),
+ textOutput("attend_more_than_45"),
+ textOutput("attend_less_than_15"),
+ textOutput("joined_after_15mins"),
+ plotOutput("plot",width="90%"),
+ plotOutput("plot2",width="90%"),
+ width=8)
+
+filetypes <- c("MS Teams Live Event", "MS Teams Webinar", "Zoom")
+
+ui <- fluidPage(
+
+ ## ui settings ---------------------------------------------------------------
+ theme = bslib::bs_theme(bootswatch = "yeti"),
+
+ ## title panel ---------------------------------------------------------------
+ titlePanel(
+ windowTitle = "Microsoft Teams and Zoom Event Statistics",
+ fixedRow(
+ column(
+ width = 1, tags$img(src="tsu_logo_yellow_screen_transparent.png", height = '90'),
+ style = "background-color:#FFFFFF;"
+ ),
+ column(
+ width = 11, h1(p("Microsoft Teams and Zoom Event Statistics"),
+ style = "font-weight:bold; font-family:Segoe UI, Helvetica, Arial, sans-serif; font-size:xx-large"),
+ style = "background-color:#FFFFFF;"
+ )
+ )
+ ),
+
+ ## sidebar -------------------------------------------------------------------
+ sidebarLayout(
+
+ ### sidebar settings ----
+ position = c("left", "right"),
+ fluid = TRUE,
+
+ ### sidebar panel ----
+ sidebarPanel(
+ fileInput("file", "Select the csv file containing the attendance data for your event:", accept = ".csv"),
+ radioButtons("file_type","Select file type", filetypes),
+ dateInput("live_event_date", "What was the date of your event?"),
+ timeInput("start", "Enter event start time (15 minute steps)", value = strptime("09:00:00", "%T"), minute.steps = 15),
+ timeInput("end", "Enter event end time (15 minute steps)", value = strptime("17:00:00", "%T"), minute.steps = 15),
+
+ # actionButton("click","Generate stats", icon("bar-chart-o"), style="color: #FFFFFF; background-color: #D20019; border-color: #8C0032")
+ ),
+
+ ## main panel ----
+ #ui_mainpanel,
+ mainPanel(
+
+ ### stats boxes ----
+ fluidRow(
+
+ valueBoxOutput(outputId = 'number_of_attendees', width = 2),
+ valueBoxOutput(outputId = 'averagetime', width = 2),
+ valueBoxOutput(outputId = 'attend_more_than_45', width = 2),
+ valueBoxOutput(outputId = 'attend_less_than_15', width = 2),
+ valueBoxOutput(outputId = 'joined_after_15mins', width = 2),
+
+ ),
+
+ fluidRow(
+ plotOutput("plot",width="90%"),
+ plotOutput("plot2",width="90%"),
+ )
+ )
+
+ )
+)
+
+# server -----------------------------------------------------------------------
+server <- function(input,output,session) {
+
+ ## file uploads --------------------------------------------------------------
+ data <- reactive({
+
+ # ensure we have a file uploaded
+ file <- req(input$file)
+
+ # determine how to load / process based on filetype
+ ext <- tools::file_ext(input$file$name)
+ d <- switch(
+ ext,
+ csv = readr::read_csv(input$file$datapath) |>
+ janitor::clean_names(),
+ validate("invalid csv")
+ ) 
+
+ # update date and time parameters on the form
+ d_events <- estimate_event_times(df = d)
+ #modaldate <-getmodaldate(d$utc_event_timestamp)
+ #shiny::updateDateInput(session, "live_event_date", value = modaldate)
+ updateDateInput(session, 'live_event_date', value = as_date(d_events$start))
+ updateTimeInput(session, 'start', value = d_events$start)
+ updateTimeInput(session, 'end', value = d_events$end)
+
+ return (d)
+ }) |>
+ bindEvent(input$file)
+
+
+ get_joined <-reactive({
+ data <- data()
+
+ validate(
+ need(nrow(data) > 0,"no rows of data uploaded"),
+ need("utc_event_timestamp" %in% colnames(data), "not correct csv")
+ )
+
+ eventdate <- ymd(input$live_event_date)
+
+ #medianhour <-getmedianhour(input$start)
+ #medianmin <-getmedianmin(input$start)
+
+ #cat(medianhour)
+ #cat(medianmin)
+
+ starttime <-ymd_hms(paste0(ymd(input$live_event_date)," ",strftime(input$start, "%T")))
+ endtime <-ymd_hms(paste0(ymd(input$live_event_date)," ",strftime(input$end, "%T")))
+ get_joined_data(data(),eventdate,starttime,endtime)
+
+ # shinyTime::updateTimeInput(session, "start", value = hms(paste0(medianhour, ":",medianmin,":00")))
+ })
+
+ ## render charts -------------------------------------------------------------
+ get_chart <-reactive({
+ create_chart(get_joined(),input$file$name,input$live_event_date)
+ })
+
+ get_chart2 <-reactive({
+ create_how_long_chart(get_joined(),input$file$name,input$live_event_date)
+ })
+
+ ## render valuebox -----------------------------------------------------------
+ # average time attending the event
+ # output$averagetime <- renderText({
+ # paste0("Average time attending the event: ",
+ # round(mean(get_joined()$how_long)),
+ # " minutes")
+ # prettyNum(round(mean(get_joined()$how_long)), big.mark = ',')
+ # })
+ output$averagetime <- renderValueBox({
+ valueBox(
+ value = paste(prettyNum(round(mean(get_joined()$how_long)), big.mark = ','), 'mins'),
+ subtitle = 'Average time attending the event',
+ icon = icon('clock'),
+ width = 2,
+ color = 'purple'
+ )
+ })
+
+ # output$attend_less_than_15 <- renderText({
+ # paste0("Attended for less than 15 minutes: ",
+ # nrow(get_joined() |>
+ # filter(how_long < 15)),
+ # " people")
+ # })
+ output$attend_less_than_15 <- renderValueBox({
+ valueBox(
+ value = paste(prettyNum(nrow(get_joined() |> filter(how_long < 15)), big.mark = ','), 'people'),
+ subtitle = 'Attended for less than 15 minutes',
+ icon = icon('stopwatch'),
+ width = 2,
+ color = 'red'
+ )
+ })
+
+ # output$number_of_attendees <- renderText({
+ # paste0("Number of attendees: ",
+ # nrow(get_joined()),
+ # " people")
+ # })
+ output$number_of_attendees <- renderValueBox({
+ valueBox(
+ value = paste(prettyNum(nrow(get_joined()), big.mark = ','), 'people'),
+ subtitle = 'Attended the event',
+ icon = icon('people-group'),
+ width = 2,
+ color = 'green'
+ )
+ })
+
+ # output$attend_more_than_45 <- renderText({
+ # paste0("Attended for more than 45 minutes: ",
+ # nrow(get_joined() |> 
+ # filter(how_long > 45)),
+ # " people")
+ # })
+ output$attend_more_than_45 <- renderValueBox({
+ valueBox(
+ value = paste(prettyNum(nrow(get_joined() |> filter(how_long > 45)), big.mark = ','), 'people'),
+ subtitle = 'Attended for more than 45 minutes',
+ icon = icon('people-line'),
+ width = 2,
+ color = 'green'
+ )
+ })
+
+ # output$joined_after_15mins <- renderText({
+ # paste0("Joined after 15 minutes: ",
+ # nrow(get_joined() |>
+ # filter(joinedtime > (ymd_hms(paste0(ymd(input$live_event_date)," ",strftime(input$start, "%T")))+900))),#900 is the number of seconds in 15 mins
+ # " people")
+ # })
+ output$joined_after_15mins <- renderValueBox({
+ valueBox(
+ value = paste(nrow(get_joined() |> filter(joinedtime > (ymd_hms(paste0(ymd(input$live_event_date)," ",strftime(input$start, "%T")))+900))), 'people'),
+ subtitle = 'Joined after 15 minutes',
+ icon = icon('right-to-bracket'),
+ width = 2,
+ color = 'green'
+ )
+ })
+
+ # output$box1 <- renderValueBox({paste0("Joined after 15 minutes: ",
+ # nrow(get_joined() |>
+ # filter(joinedtime > (ymd_hms(paste0(ymd(input$live_event_date)," ",strftime(input$start, "%T")))+900))),#900 is the number of seconds in 15 mins
+ # " people")})
+
+
+ # output$box1 <- renderValueBox({
+ # 
+ # valueBox("Over Daily Value", HTML(paste0(nrow(get_joined() |> 
+ # filter(how_long > 45)),
+ # sep="<br>")), icon = icon("exclamation-triangle"), color = "red")
+ # 
+ # })
+
+ ## build value box
+ # output$box1 <- valueBox({
+ # valueBox(
+ # (nrow(get_joined() |>
+ # filter(joinedtime > (ymd_hms(paste0(ymd(input$live_event_date)," ",strftime(input$start, "%T")))+900)))), 
+ # icon = icon('export', lib = 'glyphicon'), 
+ # color = "primary" )
+ # })
+
+ # output$box1 <- valueBox(247, caption = "Connections", icon="fa-random")
+
+
+ output$upload <- renderTable(input$upload)
+ # output$eventdate <- renderText(input$live_event_date)
+ # output$starttime <- renderText(strftime(input$start, "%T"))
+ # output$endtime <- renderText(strftime(input$end, "%T"))
+ output$plot <- renderPlot({get_chart()})
+ output$plot2 <- renderPlot({get_chart2()})
+
+}
+
+shinyApp(ui, server)