RPI StudySafe is an app that reveals the anonymous usage of Wi-Fi access points and aggregations of wireless users on - the campus network at Rensselaer Polytechnic Institute, - Troy, New York. Analysis and visualizations are by students and staff of - The Rensselaer Institute for Data Exploration and Applications (IDEA). - This is an app associated with the COVID-19 contact tracing and campus network mapping projects.
-RPI StudySafe is designed to present WAP data to on-campus users so they can make informed decisions on where to go for extended periods of time on campus. - The data can be interacted with in several ways, including selecting certain dates, times, locations, as well as through interactive geographical maps. - Geographic location and density of each WAP are combined by building, and the data is updated every two hours.
-The \"Campus Map\" tab includes a map of the RPI campus, providing a succinct overview of its behavior. - Users can customize their searches using the following selections:
- -Based on the users selection the main panel will display either a geographic map or a table. - Color indicators are based on the percentage of calculated capacity.
- -The \"Find a Place to Study\" is intended to be a go-to quicksearch of any building. - Users can customize their searches using the following selections:
- -Based on the users selection the main panel will display a graph, a recommendation, - and the summary of the analyses that led to that conclusion.
- -The \"Quick Compare\" tab is intended to be a more in depth search, involving comparison of several locations on campus at once. - Users can customize their searches using the following selections:
- -Based on the users selection the main panel will display graphs to display information about capacity limits, - and a concise comparitive analysis will be provided.
-Some of the information displayed is approximated and/or may not be 100% accurate as it is an approximation of imperfect data. - Improvements to this application will continue to be made.
-RPIStudySafe
\'); - // $(".sidebar-toggle").insertAfter(".tab-content"); - }) - ')), - - - ) -) - - -# Define server logic required -server <- function(input, output, session) { - - #ABOUT TAB - output$about_body <- renderUI({}) - - - # "Google" Tab ################################################################################################################################################### - # Set default tab to today's weekday - observe({ - weekday_now <- weekdays(Sys.Date()) - updateTabsetPanel(session,"week_tab", selected = weekday_now) - }) - - #Activity Tagging Switch consistent across all tabs - NOT WORKING YET, WILL IMPLEMENT LATER - observe({ - if (input$byActivity == FALSE) { - updatePickerInput(session, inputId = "building", choices = byCat_single) - } else { - updatePickerInput(session, inputId = "building", choices = byAct_single) - } - }) - - output$week_view <- renderUI({ - - weekday_now <- weekdays(Sys.Date()) - - # Store building selected into a reactive value - observe({ - sun_building_selected$building <- input$sun_selected - mon_building_selected$building <- input$mon_selected - tue_building_selected$building <- input$tue_selected - wed_building_selected$building <- input$wed_selected - thu_building_selected$building <- input$thu_selected - fri_building_selected$building <- input$fri_selected - sat_building_selected$building <- input$sat_selected - }) - - sun_select <- sun_building_selected$building - mon_select <- mon_building_selected$building - tue_select <- tue_building_selected$building - wed_select <- wed_building_selected$building - thu_select <- thu_building_selected$building - fri_select <- fri_building_selected$building - sat_select <- sat_building_selected$building - - sun_dat <- rpi_wap_last7 %>% filter(weekday == "Sunday") - mon_dat <- rpi_wap_last7 %>% filter(weekday == "Monday") - tue_dat <- rpi_wap_last7 %>% filter(weekday == "Tuesday") - wed_dat <- rpi_wap_last7 %>% filter(weekday == "Wednesday") - thu_dat <- rpi_wap_last7 %>% filter(weekday == "Thursday") - fri_dat <- rpi_wap_last7 %>% filter(weekday == "Friday") - sat_dat <- rpi_wap_last7 %>% filter(weekday == "Saturday") - - # Function to get map information for leaflet map - get_map_info <- function(dat, hour, hits_per_wap_semester_by_building_max) { - map_info <- dat %>% filter(Hour==hour) %>% - select(lat, lng, BuildingType,Building, users) %>% - group_by(lat, lng, BuildingType,Building) %>% - dplyr::summarise(totalusers = sum(users)) - map_info <- merge(map_info, hits_per_wap_semester_by_building_max, by.x= "Building", by.y="Building") - } - - # Function to get marker color on leaflet map - getColor <- function(dat) { - mapply(function(totalusers, capacity) { - if(totalusers <= 0.25*capacity) {"darkblue"} - else if(totalusers <= 0.5*capacity) {"lightblue"} - else if(totalusers <= 0.75*capacity) {"lightred"} - else {"red"}}, - dat$totalusers, dat$capacity) - } - - # Function to create icon on leaflet map - getIcon <- function(dat){ - icons <- awesomeIcons( - icon = 'ios-close', - iconColor = 'black', - library = 'ion', - markerColor = getColor(dat)) - } - - # Function to generate leaflet map - get_map <- function(dat) { - leaf_map <- leaflet(dat) %>% - addAwesomeMarkers(icon=getIcon(dat)) %>% - addTiles() %>%setView( lng = -73.6789, lat = 42.7298, zoom = 16 ) %>% - addLegend(position = "topleft", colors = c("#235878", "#65b7de", "#f28e80", "#c44130"), labels = c("0% ~ 25%", "25% ~ 50%", "50% ~ 75%", "75% ~ 100%")) - } - - # Function to generate comments on how busy the building is - busy_text <- function(dat, building_select, hits_per_wap_semester_by_building_max){ - building_select_cap <- subset(hits_per_wap_semester_by_building_max, hits_per_wap_semester_by_building_max$Building == building_select) - cap <- dat$users / building_select_cap$capacity - if(cap <= .25){busy_summary <- "usually not busy"} - else if(cap <= .5 & cap > .25){busy_summary <- "usually not too busy"} - else if(cap <= .75 & cap > .5){busy_summary <- "usually a bit busy"} - else {busy_summary <- "usually as busy as it can get"} - } - - all_time <- unique(sun_dat$Hour) - - # Function to generate capacity line on bar plot - capacity_intercept <- function(capacity){ - c1 <- capacity * .25 - c2 <- capacity * .5 - c3 <- capacity * .75 - cut <- c(c1, c2, c3, capacity) - } - - # Function to make bar plot - make_plot <- function(dat, time_now, building_select, hits_per_wap_semester_by_building_max){ - building_select_cap <- subset(hits_per_wap_semester_by_building_max, hits_per_wap_semester_by_building_max$Building == building_select) - cap_line <- capacity_intercept(building_select_cap$capacity) - ggplot(dat, aes(x=factor(Hour), y=users, fill=(Hour==time_now))) + - geom_bar(stat="identity") + - scale_fill_manual(values=c("skyblue3","mediumvioletred")) + - geom_vline(xintercept = as.integer(time_now)+1, linetype = "dotted") + - geom_hline(yintercept = cap_line, linetype = "dotted") + - scale_x_discrete(labels= all_time) + - scale_y_continuous(breaks = cap_line, labels = c("25%", "50%", "75%", "100%")) + - ylab("Building Capacity") + - theme(panel.grid.major = element_blank(), - panel.grid.minor = element_blank(), - panel.background = element_blank(), - plot.background = element_blank(), - axis.ticks.y = element_blank(), - axis.ticks.x = element_blank(), - axis.title.x=element_blank(), - legend.position="none") - } - - # Sunday Tab - sun_react_click <- reactiveValues(Clicks=NULL) - observeEvent(input$sun_click, { - click <- as.numeric(input$sun_click$x) - as.numeric(input$sun_click$domain$left) - sun_react_click$Clicks <- click - }) - - # If click a marker on leaflet map, update the marker color to green and the building selection on the side panel - observeEvent(input$sunMap_marker_click,{ - req(input$sunMap_marker_click) - clicks <- data.frame(input$sunMap_marker_click[3:4]) - icon <- awesomeIcons(icon = 'ios-close', iconColor="black", library='ion', markerColor="green") - leafletProxy("sunMap") %>% clearGroup(group="selected") %>% addAwesomeMarkers(icon= icon, data = clicks, group="selected") - building_select <- sun_dat %>% filter(lng==clicks[,2], lat==clicks[,1]) %>% select(Building) - building_select <- unique(building_select) - updatePickerInput(session, inputId="sun_selected", selected=building_select) - }) - - # If change the building selection on the side panel, update the marker on the map to green - observeEvent(input$sun_selected,{ - clicks <- sun_dat %>% filter(Building==sun_select) %>% select(lat,lng) - clicks <- clicks[1,1:2] - icon <- awesomeIcons(icon = 'ios-close', iconColor="black", library='ion', markerColor="green") - leafletProxy("sunMap") %>% clearGroup(group="selected") %>% addAwesomeMarkers(icon= icon, data = clicks, group="selected") - }) - - # Create the leaflet map and bar plot - observe({ - time_now <- as.integer(format(Sys.time(), "%H")) - sun_select_dat <- sun_dat %>% filter(Building == sun_select) - # If nothing is clicked, the bar plot by default will use the current time - if (is.null(sun_react_click$Clicks)){ - sun_hr_dat <- sun_select_dat[time_now+1,] - hr_pick_plot <- make_plot(sun_select_dat, time_now, sun_select, hits_per_wap_semester_by_building_max) - output_text <- busy_text(sun_hr_dat, sun_hr_dat$Building, hits_per_wap_semester_by_building_max) - sun_map_info <- get_map_info(sun_dat, time_now, hits_per_wap_semester_by_building_max) - leaf_map <- get_map(sun_map_info) - output$sunMap <- renderLeaflet({leaf_map}) - output$sun_plot <- renderPlot({hr_pick_plot}, bg="transparent") - output$sun_info <- renderUI({p("At", as.numeric(sun_hr_dat$Hour), ":00,",sun_select, "is", output_text)}) - } else { - sun_hr_dat <- sun_select_dat[floor(sun_react_click$Clicks)+1,] - output_text <- busy_text(sun_hr_dat, sun_hr_dat$Building, hits_per_wap_semester_by_building_max) - # time_now <- as.integer(sun_react_click$Clicks) - time_now <- sun_hr_dat$Hour - sun_map_info <- get_map_info(sun_dat, time_now, hits_per_wap_semester_by_building_max) - leaf_map <- get_map(sun_map_info) - output$sunMap <- renderLeaflet({leaf_map}) - hr_pick_plot <- make_plot(sun_select_dat, time_now, sun_select, hits_per_wap_semester_by_building_max) - output$sun_plot <- renderPlot({hr_pick_plot}, bg="transparent") - output$sun_info <- renderUI({p("At", as.numeric(sun_hr_dat$Hour), ":00,", sun_select,"is", output_text)}) - } - }) - - # Monday Tab - mon_react_click <- reactiveValues(Clicks=NULL) - observeEvent(input$mon_click, { - click <- as.numeric(input$mon_click$x) - as.numeric(input$mon_click$domain$left) - mon_react_click$Clicks <- click - }) - - observeEvent(input$monMap_marker_click,{ - req(input$monMap_marker_click) - clicks <- data.frame(input$monMap_marker_click[3:4]) - icon <- awesomeIcons(icon = 'ios-close', iconColor="black", library='ion', markerColor="green") - leafletProxy("monMap") %>% clearGroup(group="selected") %>% addAwesomeMarkers(icon= icon, data = clicks, group="selected") - building_select <- mon_dat %>% filter(lng==clicks[,2], lat==clicks[,1]) %>% select(Building) - building_select <- unique(building_select) - updatePickerInput(session, inputId="mon_selected", selected=building_select) - }) - - observeEvent(input$mon_selected,{ - clicks <- mon_dat %>% filter(Building==mon_select) %>% select(lat,lng) - clicks <- clicks[1,1:2] - icon <- awesomeIcons(icon = 'ios-close', iconColor="black", library='ion', markerColor="green") - leafletProxy("monMap") %>% clearGroup(group="selected") %>% addAwesomeMarkers(icon= icon, data = clicks, group="selected") - }) - - observe({ - time_now <- as.integer(format(Sys.time(), "%H")) - mon_select_dat <- mon_dat %>% filter(Building == mon_select) - if (is.null(mon_react_click$Clicks)){ - mon_hr_dat <- mon_select_dat[time_now+1,] - hr_pick_plot <- make_plot(mon_select_dat, time_now, mon_select, hits_per_wap_semester_by_building_max) - output_text <- busy_text(mon_hr_dat, mon_hr_dat$Building, hits_per_wap_semester_by_building_max) - mon_map_info <- get_map_info(mon_dat, time_now, hits_per_wap_semester_by_building_max) - leaf_map <- get_map(mon_map_info) - output$monMap <- renderLeaflet({leaf_map}) - output$mon_plot <- renderPlot({hr_pick_plot}, bg="transparent") - output$mon_info <- renderUI({p("At", as.numeric(mon_hr_dat$Hour), ":00,",mon_select, "is", output_text)}) - } else { - mon_hr_dat <- mon_select_dat[floor(mon_react_click$Clicks)+1,] - output_text <- busy_text(mon_hr_dat, mon_hr_dat$Building, hits_per_wap_semester_by_building_max) - # time_now <- as.integer(sat_react_click$Clicks) - time_now <- mon_hr_dat$Hour - mon_map_info <- get_map_info(mon_dat, time_now, hits_per_wap_semester_by_building_max) - leaf_map <- get_map(mon_map_info) - output$monMap <- renderLeaflet({leaf_map}) - hr_pick_plot <- make_plot(mon_select_dat, time_now, mon_select, hits_per_wap_semester_by_building_max) - output$mon_plot <- renderPlot({hr_pick_plot}, bg="transparent") - output$mon_info <- renderUI({p("At", as.numeric(mon_hr_dat$Hour), ":00,", mon_select,"is", output_text)}) - } - }) - - # Tuesday Tab - tue_react_click <- reactiveValues(Clicks=NULL) - observeEvent(input$tue_click, { - click <- as.numeric(input$tue_click$x) - as.numeric(input$tue_click$domain$left) - tue_react_click$Clicks <- click - }) - - observeEvent(input$tueMap_marker_click,{ - req(input$tueMap_marker_click) - clicks <- data.frame(input$tueMap_marker_click[3:4]) - icon <- awesomeIcons(icon = 'ios-close', iconColor="black", library='ion', markerColor="green") - leafletProxy("tueMap") %>% clearGroup(group="selected") %>% addAwesomeMarkers(icon= icon, data = clicks, group="selected") - building_select <- tue_dat %>% filter(lng==clicks[,2], lat==clicks[,1]) %>% select(Building) - building_select <- unique(building_select) - updatePickerInput(session, inputId="tue_selected", selected=building_select) - }) - - observeEvent(input$tue_selected,{ - clicks <- tue_dat %>% filter(Building==tue_select) %>% select(lat,lng) - clicks <- clicks[1,1:2] - icon <- awesomeIcons(icon = 'ios-close', iconColor="black", library='ion', markerColor="green") - leafletProxy("tueMap") %>% clearGroup(group="selected") %>% addAwesomeMarkers(icon= icon, data = clicks, group="selected") - }) - - observe({ - time_now <- as.integer(format(Sys.time(), "%H")) - tue_select_dat <- tue_dat %>% filter(Building == tue_select) - if (is.null(tue_react_click$Clicks)){ - tue_hr_dat <- tue_select_dat[time_now+1,] - hr_pick_plot <- make_plot(tue_select_dat, time_now, tue_select, hits_per_wap_semester_by_building_max) - output_text <- busy_text(tue_hr_dat, tue_hr_dat$Building, hits_per_wap_semester_by_building_max) - tue_map_info <- get_map_info(tue_dat, time_now, hits_per_wap_semester_by_building_max) - leaf_map <- get_map(tue_map_info) - output$tueMap <- renderLeaflet({leaf_map}) - output$tue_plot <- renderPlot({hr_pick_plot}, bg="transparent") - output$tue_info <- renderUI({p("At", as.numeric(tue_hr_dat$Hour), ":00,",tue_select, "is", output_text)}) - } else { - tue_hr_dat <- tue_select_dat[floor(tue_react_click$Clicks)+1,] - output_text <- busy_text(tue_hr_dat, tue_hr_dat$Building, hits_per_wap_semester_by_building_max) - # time_now <- as.integer(tue_react_click$Clicks) - time_now <- tue_hr_dat$Hour - tue_map_info <- get_map_info(tue_dat, time_now, hits_per_wap_semester_by_building_max) - leaf_map <- get_map(tue_map_info) - output$tueMap <- renderLeaflet({leaf_map}) - hr_pick_plot <- make_plot(tue_select_dat, time_now, tue_select, hits_per_wap_semester_by_building_max) - output$tue_plot <- renderPlot({hr_pick_plot}, bg="transparent") - output$tue_info <- renderUI({p("At", as.numeric(tue_hr_dat$Hour), ":00,", tue_select,"is", output_text)}) - } - }) - - # Wednesday Tab - wed_react_click <- reactiveValues(Clicks=NULL) - observeEvent(input$wed_click, { - click <- as.numeric(input$wed_click$x) - as.numeric(input$wed_click$domain$left) - wed_react_click$Clicks <- click - }) - - observeEvent(input$wedMap_marker_click,{ - req(input$wedMap_marker_click) - clicks <- data.frame(input$wedMap_marker_click[3:4]) - icon <- awesomeIcons(icon = 'ios-close', iconColor="black", library='ion', markerColor="green") - leafletProxy("wedMap") %>% clearGroup(group="selected") %>% addAwesomeMarkers(icon= icon, data = clicks, group="selected") - building_select <- wed_dat %>% filter(lng==clicks[,2], lat==clicks[,1]) %>% select(Building) - building_select <- unique(building_select) - updatePickerInput(session, inputId="wed_selected", selected=building_select) - }) - - observeEvent(input$wed_selected,{ - clicks <- wed_dat %>% filter(Building==wed_select) %>% select(lat,lng) - clicks <- clicks[1,1:2] - icon <- awesomeIcons(icon = 'ios-close', iconColor="black", library='ion', markerColor="green") - leafletProxy("wedMap") %>% clearGroup(group="selected") %>% addAwesomeMarkers(icon= icon, data = clicks, group="selected") - }) - - observe({ - time_now <- as.integer(format(Sys.time(), "%H")) - wed_select_dat <- wed_dat %>% filter(Building == wed_select) - if (is.null(wed_react_click$Clicks)){ - wed_hr_dat <- wed_select_dat[time_now+1,] - hr_pick_plot <- make_plot(wed_select_dat, time_now, wed_select, hits_per_wap_semester_by_building_max) - output_text <- busy_text(wed_hr_dat, wed_hr_dat$Building, hits_per_wap_semester_by_building_max) - wed_map_info <- get_map_info(wed_dat, time_now, hits_per_wap_semester_by_building_max) - leaf_map <- get_map(wed_map_info) - output$wedMap <- renderLeaflet({leaf_map}) - output$wed_plot <- renderPlot({hr_pick_plot}, bg="transparent") - output$wed_info <- renderUI({p("At", as.numeric(wed_hr_dat$Hour), ":00,",wed_select, "is", output_text)}) - } else { - wed_hr_dat <- wed_select_dat[floor(wed_react_click$Clicks)+1,] - output_text <- busy_text(wed_hr_dat, wed_hr_dat$Building, hits_per_wap_semester_by_building_max) - # time_now <- as.integer(wed_react_click$Clicks) - time_now <- wed_hr_dat$Hour - wed_map_info <- get_map_info(wed_dat, time_now, hits_per_wap_semester_by_building_max) - leaf_map <- get_map(wed_map_info) - output$wedMap <- renderLeaflet({leaf_map}) - hr_pick_plot <- make_plot(wed_select_dat, time_now, wed_select, hits_per_wap_semester_by_building_max) - output$wed_plot <- renderPlot({hr_pick_plot}, bg="transparent") - output$wed_info <- renderUI({p("At", as.numeric(wed_hr_dat$Hour), ":00,", wed_select,"is", output_text)}) - } - }) - - # Thursday Tab - thu_react_click <- reactiveValues(Clicks=NULL) - - observeEvent(input$thu_click, { - click <- as.numeric(input$thu_click$x) - as.numeric(input$thu_click$domain$left) - thu_react_click$Clicks <- click - }) - - observeEvent(input$thuMap_marker_click,{ - req(input$thuMap_marker_click) - clicks <- data.frame(input$thuMap_marker_click[3:4]) - icon <- awesomeIcons(icon = 'ios-close', iconColor="black", library='ion', markerColor="green") - leafletProxy("thuMap") %>% clearGroup(group="selected") %>% addAwesomeMarkers(icon= icon, data = clicks, group="selected") - building_select <- thu_dat %>% filter(lng==clicks[,2], lat==clicks[,1]) %>% select(Building) - building_select <- unique(building_select) - updatePickerInput(session, inputId="thu_selected", selected=building_select) - }) - - observeEvent(input$thu_selected,{ - clicks <- thu_dat %>% filter(Building==thu_select) %>% select(lat,lng) - clicks <- clicks[1,1:2] - icon <- awesomeIcons(icon = 'ios-close', iconColor="black", library='ion', markerColor="green") - leafletProxy("thuMap") %>% clearGroup(group="selected") %>% addAwesomeMarkers(icon= icon, data = clicks, group="selected") - }) - - observe({ - time_now <- as.integer(format(Sys.time(), "%H")) - thu_select_dat <- thu_dat %>% filter(Building == thu_select) - if (is.null(thu_react_click$Clicks)){ - thu_hr_dat <- thu_select_dat[time_now+1,] - hr_pick_plot <- make_plot(thu_select_dat, time_now, thu_select, hits_per_wap_semester_by_building_max) - output_text <- busy_text(thu_hr_dat, thu_hr_dat$Building, hits_per_wap_semester_by_building_max) - thu_map_info <- get_map_info(thu_dat, time_now, hits_per_wap_semester_by_building_max) - leaf_map <- get_map(thu_map_info) - output$thuMap <- renderLeaflet({leaf_map}) - output$thu_plot <- renderPlot({hr_pick_plot}, bg="transparent") - output$thu_info <- renderUI({p("At", as.numeric(thu_hr_dat$Hour), ":00,",thu_select, "is", output_text)}) - } else { - thu_hr_dat <- thu_select_dat[floor(thu_react_click$Clicks)+1,] - output_text <- busy_text(thu_hr_dat, thu_hr_dat$Building, hits_per_wap_semester_by_building_max) - # time_now <- as.integer(thu_react_click$Clicks) - time_now <- thu_hr_dat$Hour - thu_map_info <- get_map_info(thu_dat, time_now, hits_per_wap_semester_by_building_max) - leaf_map <- get_map(thu_map_info) - output$thuMap <- renderLeaflet({leaf_map}) - hr_pick_plot <- make_plot(thu_select_dat, time_now, thu_select, hits_per_wap_semester_by_building_max) - output$thu_plot <- renderPlot({hr_pick_plot}, bg="transparent") - output$thu_info <- renderUI({p("At", as.numeric(thu_hr_dat$Hour), ":00,", thu_select,"is", output_text)}) - } - }) - - # Friday Tab - fri_react_click <- reactiveValues(Clicks=NULL) - observeEvent(input$fri_click, { - click <- as.numeric(input$fri_click$x) - as.numeric(input$fri_click$domain$left) - fri_react_click$Clicks <- click - }) - - observeEvent(input$friMap_marker_click,{ - req(input$friMap_marker_click) - clicks <- data.frame(input$friMap_marker_click[3:4]) - icon <- awesomeIcons(icon = 'ios-close', iconColor="black", library='ion', markerColor="green") - leafletProxy("friMap") %>% clearGroup(group="selected") %>% addAwesomeMarkers(icon= icon, data = clicks, group="selected") - building_select <- fri_dat %>% filter(lng==clicks[,2], lat==clicks[,1]) %>% select(Building) - building_select <- unique(building_select) - updatePickerInput(session, inputId="fri_selected", selected=building_select) - }) - - observeEvent(input$fri_selected,{ - clicks <- fri_dat %>% filter(Building==fri_select) %>% select(lat,lng) - clicks <- clicks[1,1:2] - icon <- awesomeIcons(icon = 'ios-close', iconColor="black", library='ion', markerColor="green") - leafletProxy("friMap") %>% clearGroup(group="selected") %>% addAwesomeMarkers(icon= icon, data = clicks, group="selected") - }) - - observe({ - time_now <- as.integer(format(Sys.time(), "%H")) - fri_select_dat <- fri_dat %>% filter(Building == fri_select) - if (is.null(fri_react_click$Clicks)){ - fri_hr_dat <- fri_select_dat[time_now+1,] - hr_pick_plot <- make_plot(fri_select_dat, time_now, fri_select, hits_per_wap_semester_by_building_max) - output_text <- busy_text(fri_hr_dat, fri_hr_dat$Building, hits_per_wap_semester_by_building_max) - fri_map_info <- get_map_info(fri_dat, time_now, hits_per_wap_semester_by_building_max) - leaf_map <- get_map(fri_map_info) - output$friMap <- renderLeaflet({leaf_map}) - output$fri_plot <- renderPlot({hr_pick_plot}, bg="transparent") - output$fri_info <- renderUI({p("At", as.numeric(fri_hr_dat$Hour), ":00,",fri_select, "is", output_text)}) - } else { - fri_hr_dat <- fri_select_dat[floor(fri_react_click$Clicks)+1,] - output_text <- busy_text(fri_hr_dat, fri_hr_dat$Building, hits_per_wap_semester_by_building_max) - # time_now <- as.integer(fri_react_click$Clicks) - time_now <- fri_hr_dat$Hour - fri_map_info <- get_map_info(fri_dat, time_now, hits_per_wap_semester_by_building_max) - leaf_map <- get_map(fri_map_info) - output$friMap <- renderLeaflet({leaf_map}) - hr_pick_plot <- make_plot(fri_select_dat, time_now, fri_select, hits_per_wap_semester_by_building_max) - output$fri_plot <- renderPlot({hr_pick_plot}, bg="transparent") - output$fri_info <- renderUI({p("At", as.numeric(fri_hr_dat$Hour), ":00,", fri_select,"is", output_text)}) - } - }) - - # Saturday Tab - sat_react_click <- reactiveValues(Clicks=NULL) - observeEvent(input$sat_click, { - click <- as.numeric(input$sat_click$x) - as.numeric(input$sat_click$domain$left) - sat_react_click$Clicks <- click - }) - - observeEvent(input$satMap_marker_click,{ - req(input$satMap_marker_click) - clicks <- data.frame(input$satMap_marker_click[3:4]) - icon <- awesomeIcons(icon = 'ios-close', iconColor="black", library='ion', markerColor="green") - leafletProxy("satMap") %>% clearGroup(group="selected") %>% addAwesomeMarkers(icon= icon, data = clicks, group="selected") - building_select <- sat_dat %>% filter(lng==clicks[,2], lat==clicks[,1]) %>% select(Building) - building_select <- unique(building_select) - updatePickerInput(session, inputId="sat_selected", selected=building_select) - }) - - observeEvent(input$sat_selected,{ - clicks <- sat_dat %>% filter(Building==sat_select) %>% select(lat,lng) - clicks <- clicks[1,1:2] - icon <- awesomeIcons(icon = 'ios-close', iconColor="black", library='ion', markerColor="green") - leafletProxy("satMap") %>% clearGroup(group="selected") %>% addAwesomeMarkers(icon= icon, data = clicks, group="selected") - }) - - observe({ - time_now <- as.integer(format(Sys.time(), "%H")) - sat_select_dat <- sat_dat %>% filter(Building == sat_select) - if (is.null(sat_react_click$Clicks)){ - sat_hr_dat <- sat_select_dat[time_now+1,] - hr_pick_plot <- make_plot(sat_select_dat, time_now, sat_select, hits_per_wap_semester_by_building_max) - output_text <- busy_text(sat_hr_dat, sat_hr_dat$Building, hits_per_wap_semester_by_building_max) - sat_map_info <- get_map_info(sat_dat, time_now, hits_per_wap_semester_by_building_max) - leaf_map <- get_map(sat_map_info) - output$satMap <- renderLeaflet({leaf_map}) - output$sat_plot <- renderPlot({hr_pick_plot}, bg="transparent") - output$sat_info <- renderUI({p("At", as.numeric(sat_hr_dat$Hour), ":00,",sat_select, "is", output_text)}) - } else { - sat_hr_dat <- sat_select_dat[floor(sat_react_click$Clicks)+1,] - output_text <- busy_text(sat_hr_dat, sat_hr_dat$Building, hits_per_wap_semester_by_building_max) - # time_now <- as.integer(sat_react_click$Clicks) - time_now <- sat_hr_dat$Hour - sat_map_info <- get_map_info(sat_dat, time_now, hits_per_wap_semester_by_building_max) - leaf_map <- get_map(sat_map_info) - output$satMap <- renderLeaflet({leaf_map}) - hr_pick_plot <- make_plot(sat_select_dat, time_now, sat_select, hits_per_wap_semester_by_building_max) - output$sat_plot <- renderPlot({hr_pick_plot}, bg="transparent") - output$sat_info <- renderUI({p("At", as.numeric(sat_hr_dat$Hour), ":00,", sat_select,"is", output_text)}) - } - }) - }) - - ##INITIAL POP-UP WARNING - # Content of modal dialog - query_modal <- modalDialog( - title = tags$div(HTML("WARNING: The StudySafe application represents experimental, student-created work. Reasonable - effort has been made to provide a safe, informative, enjoyable user experience, but - some StudySafe application features may not comply with Web Content Accessibility Guidelines (WCAG). - Use at your own risk.
- ")), - easyClose = F, - footer = tagList( - actionButton("run", "Continue to StudySafe", style = ' color: white; background-color:#990000') - ) - ) - - # Creates modal dialog - showModal(query_modal) - - # Removes modal - observeEvent(input$run, { - removeModal() - }) -} - -# Run the application -shinyApp(ui = ui, server = server) \ No newline at end of file diff --git a/app.R b/app.R index bea0d359..b4cd0ed1 100644 --- a/app.R +++ b/app.R @@ -9,7 +9,8 @@ options(tidyverse.quiet = TRUE) Sys.setenv(TZ="America/New_York") #document for reading in the relevant libraries, data, and cleaning -source('read_wapData.R') +# source('read_wapData_vol.R') # Use for production deployment +source('read_wapData.R') # Use for dev # Data for Roma's additions buildinghoursAccessInfo <- read_csv("buildinghoursAccessInfo.csv") diff --git a/read_wapData_vol.R b/read_wapData_vol.R new file mode 100644 index 00000000..45971d4c --- /dev/null +++ b/read_wapData_vol.R @@ -0,0 +1,348 @@ +#Reading in the data and necessary libraries and data for RPI StudySafe App +#Created by Kara Kniss + +################################################################################################################ +#READING IN THE NECESSARY LIBRARIES +################################################################################################################ +#load the packages if they are not already loaded +packages <- c("shiny", "shinydashboard", "shinyjs", "ggplot2", "shinyWidgets", "tidyverse", "tidyr", + "lubridate", "plyr", "scales", "zoo", "ggalt", "leaflet", "plotly", "wesanderson", "reactable") +new.packages <- packages[!(packages %in% installed.packages()[,"Package"])] +if (length(new.packages) > 0) { + install.packages(new.packages) +} + +library(shiny) +library(shinydashboard) +library(shinyjs) +library(ggplot2) +library(shinyWidgets) +library(tidyverse) +library(tidyr) +library(lubridate) +library(plyr) +library(scales) +library(zoo) +library(ggalt) +library(leaflet) +library(plotly) +library(wesanderson) +library(reactable) +library(DT) +library(dplyr) + +################################################################################################################ +###READING IN NECESSARY FILES +################################################################################################################ +#rpi_wap_raw(one month): Min_30, devname, maccount, usercount, datetime, date_time, Date, Building, Floor, Room, latitude, longitude, buldingType, abbrev, time +rpi_wap_raw <- readRDS("/data/rpi_wap_raw.rds") + +#combined_wap_data(one month): building, time, Date, latitude, longitude, buildingType, abbrev, users, macs, +combined_wap_data <- readRDS("/data/combined_wap_data.rds") + +#rpi_wap_stats: devname, Day, maccount_mean, maccount_med, maccount_max, usrecount_mean, usercount_med, usercount_max +rpi_wap_stats <- readRDS("/data/rpi_wifi_semester_day_summary.rds") + +#rpi_wap_week(whole semester): devname, maccount, usercount, datetime, date_time, Date, Day +#rpi_wap_week <- readRDS("/data/rpi_wifi_semester_extended.rds") + +#buildinginfo: Building, latitude, longitude, buildingType, abbrev +#buildinginfo <- readRDS("/data/buildinginfo.rds") + +#user_prediction: Building, weekday, Hour, users, Mean_Usercount, latitude, longitude, buildingType +user_predictions <- readRDS("/data/median_last3wks_with_floors.rds") + +################################################################################################################ +###CLEANING DATA +################################################################################################################ +#rpi_wap_raw: devname, users, Date, Building, Hour, lat, lng, BuildingType +rpi_wap_raw <- rpi_wap_raw %>% mutate(Hour = hour(as.POSIXct(time))) %>% select(devname, usercount, Date, Building, Hour, latitude, longitude, buildingType) +colnames(rpi_wap_raw) <- c('devname', 'users', 'Date', 'Building', 'Hour', 'lat', 'lng', 'BuildingType') +remove_list <- c("SAE, 12 Myrtle Ave off Pawling Ave", "Peoples Ave #1002", "Peoples Ave #1516", "Peoples Ave #901", "Peoples Ave #907", "President's House") +rpi_wap_raw <- rpi_wap_raw %>% filter(BuildingType != "housing" & BuildingType != "greek") %>% + filter(!(Building %in% remove_list)) + +#combined_wap_data: Building, Hour, lat, lng, BuildingType +rpi_wap_last7 <- combined_wap_data %>% mutate(Hour = hour(as.POSIXct(time))) %>% select(Building, users, Date, Building, Hour, latitude, longitude, buildingType) +rpi_wap_last7 <- rpi_wap_last7 %>% group_by(Building, Date, Hour, latitude, longitude, buildingType) %>% summarise_all(funs(max)) %>% ungroup() +colnames(rpi_wap_last7) <- c('Building', 'Date', 'Hour','lat','lng', 'BuildingType', 'users' ) +rpi_wap_last7 <- rpi_wap_last7 %>% filter(BuildingType != "housing" & BuildingType != "greek") %>% + filter(!(Building %in% remove_list)) +rpi_wap_last7$weekday <- weekdays(rpi_wap_last7$Date) + +#bldgs(getting buildings to append to devnames): devname, Building +bldgs <- rpi_wap_raw %>% filter(Date == min(rpi_wap_last7$Date)+1) %>% filter(Hour==12) %>% select(devname, Building) + +# hits_per_wap_semester_by_building_max(getting maximum number of users for each building): Building, capacity +hits_per_wap_semester_by_building_max <- merge(rpi_wap_stats, bldgs, by.x= "devname", by.y="devname") +hits_per_wap_semester_by_building_max <- hits_per_wap_semester_by_building_max %>% group_by(devname, Building, Day) %>% summarise_all(funs(max)) %>% ungroup() %>% select(devname, Day, usercount_max, Building) +hits_per_wap_semester_by_building_max <- hits_per_wap_semester_by_building_max[,2:ncol(hits_per_wap_semester_by_building_max)] +hits_per_wap_semester_by_building_max <- hits_per_wap_semester_by_building_max %>% group_by(Building, Day) %>% summarise_all(funs(sum)) %>% ungroup() +hits_per_wap_semester_by_building_max <- hits_per_wap_semester_by_building_max %>% group_by(Building) %>% summarise_all(funs(max)) %>% ungroup() %>% select(Building, usercount_max) +colnames(hits_per_wap_semester_by_building_max) <- c('Building', 'capacity') + +user_predictions <- user_predictions %>% + dplyr::group_by(Building, Weekday, Hour, lat, lng, BuildingType) %>% + dplyr::summarize(totalusers = sum(users)) %>% + ungroup() + +names(user_predictions)[names(user_predictions) == 'Weekday'] <- 'weekday' +names(user_predictions)[names(user_predictions) == 'totalusers'] <- 'users' + +################################################################################################################ +## DEFININING LISTS AND DATA FRAMES FOR CONVENIENCE +################################################################################################################ + +#Setting Colors +lightcolor <- "#ff2500" +darkcolor <- "#9a1600" + +#creating a time list for the graphs so they aren't in military time +time <- list('12:00am'= 0,'1:00am'=1, '2:00am'=2, '3:00am'=3, '4:00am'=4, '5:00am'=5, '6:00am'=6, '7:00am'=7, '8:00am'=8, '9:00am'=9, '10:00am'=10, "11:00am"=11, "12:00pm"=12, "1:00pm"=13, "2:00pm"=14, "3:00pm"=15, "4:00pm"=16, "5:00pm"=17, "6:00pm"=18, "7:00pm"=19, "8:00pm"=20, "9:00pm"=21,"10:00pm"=22, "11:00pm"=23) +Time_num <- c(0:23) +Time_AMPM <- c('12am', '1am', '2am', '3am', '4am', '5am', '6am', '7am', '8am', '9am', '10am', '11am', '12pm', '1pm', '2pm','3pm', '4pm', '5pm', '6pm', '7pm', '8pm', '9pm', '10pm', '11pm' ) +Time_noLabel <- c(12,1,2,3,4,5,6,7,8,9,10,11,12,1,2,3,4,5,6,7,8,9,10,11) +time.data <- data.frame(Time_num, Time_AMPM, Time_noLabel, stringsAsFactors=FALSE) + +#defining the max date and min date info +min_date <- min(rpi_wap_last7$Date) +max_date <- max(rpi_wap_last7$Date) +max_time_of_max_date <- max(rpi_wap_last7[rpi_wap_last7$Date == max(rpi_wap_last7$Date),]$Hour)+1 +min_time_of_min_date <- min(rpi_wap_last7[rpi_wap_last7$Date == min(rpi_wap_last7$Date),]$Hour)+1 + +date_app <- reactiveValues(date = max_date) # Remember the input date for future use +time_app <- reactiveValues(time = 0) # Remember the input time for future use +building_selected <- reactiveValues(building = 'Amos Eaton') # Remember the name of selected building for future use +data <- reactiveValues(clickedMarker=NULL) +map_latitude <- reactiveValues(lat=0) +map_longitude <- reactiveValues(lng=0) +hr <- as.integer(format(Sys.time(), "%H")) +hr_now <- reactiveValues(time=hr) +map_click <- reactive({"Amos Eaton"}) + +#weekday information +#getting selected weekday +day <- c("Sunday", "Monday", "Tuesday", "Wednesday", "Thursday", "Friday", "Saturday" ) +dayVal<- c(1,2,3,4,5,6,7) +weekpair <- data.frame(day,dayVal, stringsAsFactors=FALSE) + +#weekly3_stats(Getting average users of the last three weeks by day): Building, Hour, users, dayVal +weekly3_stats <- rpi_wap_last7 %>% filter(Date >= min_date -21) %>% mutate(dayVal = wday(Date)) %>% select(Building, Hour, users, dayVal) +weekly3_stats <- weekly3_stats %>% group_by(Building, dayVal, Hour) %>% summarise_all(funs(mean)) %>% ungroup() +weekly3_stats$users <- round(weekly3_stats$users) + +################################################################################################################ +## Activity Tagging +################################################################################################################ +#Student Favorites +Favorites <- c('CII', + 'DCC', + 'Folsom Library', + 'Rensselaer Union', + 'Voorhees Computing Center') + +#Grab a Bite to Eat: places to get food and drinks +Food <- c('Moes, College Ave', + 'Commons Dining Hall', + 'Russell Sage Dining Hall', + 'Blitman Commons') + +#Wellness: gyms, activity areas +Wellness <- c('ASRC', + 'ECAV arena', + 'ECAV stadium', + 'Houston Field House', + 'Fitness Center', + '87 Gym', + 'Robison Pool') + +#Student Resources, lounges, etc +Resources <- c("15th St #1528, Grad Ed", + "Admissions", + "ASRC auto shop", + "ASRC garage", + "East Campus Community Center", + "Off Campus Commons, 1525 15th St", + "Visitor Information Center, Public Safety") + +#Academic: Academic buildings +Academic <- c('Academy Hall', + 'Amos Eaton', + 'Carnegie Building', + 'EMPAC', + 'Greene Building', + 'JEC', + 'Lally Building', + 'Pittsburgh Building', + 'Sage Lab', + 'Science Center', + 'Winslow Building', + 'Ricketts Building', + "West Hall") + +#Research Buildings and Centers +Research <- c('Materials Research Center', + 'CBIS', + 'LINAC/NES, Tibbits Ave', + 'Polymer Center', + 'Watervliet Facility, 805 25th St, Watervliet', + 'DFWI, Lake George', + 'Jordan Road #405, Tech Park, CCI', + 'Jordan Road #465, Tech Park', + 'Cogswell Lab') + +#Other Resources/ Administrative Buildings +Admin <- c('J Building, Peoples Ave', + # "President's House", + "Proctors Building, downtown", + "Service Building, Peoples Ave", + "Troy Building", + "Walker Lab", + "Gurley Building, downtown", + "H Building") + +#Other Buildings, off and near Campus +Other <- c("City Station South", + "City Station West", + "College Ave #90, EMPAC resident artists", + "College Ave #92, RPI Ambulance", + "Old Bumstead Garage, behind Colonie Apts", + # "SAE, 12 Myrtle Ave off Pawling Ave", + "Rensselaer at Hartford") +# "Peoples Ave #1002", +# "Peoples Ave #1516", +# "Peoples Ave #901", +# "Peoples Ave #907") + +#Sleep: Housing +# Sleep <- unique((rpi_wap_last7 %>% filter(BuildingType %in% c('housing')) %>% select(Building))$Building) +# Sleep <- unique((rpi_wap_last7 %>% filter(BuildingType %in% c('housing', 'greek')) %>% select(Building))$Building) +# filter <- c(Favorites, Food, Wellness, Resources, Academic, Research, Admin, Other) +# Sleep <- Sleep[which(!Sleep %in% filter)] + +#List for selectInput +byCat_single <- list( + "Academic" = as.vector(unique((rpi_wap_last7 %>% filter(BuildingType=='academic') %>% select(Building))$Building)), + "Other On Campus" = as.vector(unique((rpi_wap_last7 %>% filter(BuildingType=='otherOnCampus') %>% select(Building))$Building)), + "Other Off Campus" = as.vector(unique((rpi_wap_last7 %>% filter(BuildingType=='otherOffCampus') %>% select(Building))$Building)) + # "Greek" = as.vector(unique((rpi_wap_last7 %>% filter(BuildingType=='greek') %>% select(Building))$Building)), + # "Housing" = as.vector(unique((rpi_wap_last7 %>% filter(BuildingType=='housing') %>% select(Building))$Building)) +) + +byCat_multi <- list( + "Nothing Selected" = as.vector('None'), + "Academic" = as.vector(unique(rpi_wap_last7 %>% filter(BuildingType=='academic') %>% select(Building))$Building), + "Other On Campus" = as.vector(unique(rpi_wap_last7 %>% filter(BuildingType=='otherOnCampus') %>% select(Building))$Building), + "Other Off Campus" = as.vector(unique(rpi_wap_last7 %>% filter(BuildingType=='otherOffCampus') %>% select(Building))$Building) + # "Greek" = as.vector(unique(rpi_wap_last7 %>% filter(BuildingType=='greek') %>% select(Building))$Building), + # "Housing" = as.vector(unique(rpi_wap_last7 %>% filter(BuildingType=='housing') %>% select(Building))$Building) +) + +byAct_single <- list( + "Common Favorites" = as.vector(Favorites), + "Academic Buildings" = as.vector(Academic), + "Food and Drinks" = as.vector(Food), + "Wellness" = as.vector(Wellness), + "Student Resources" = as.vector(Resources), + "Administration" = as.vector(Admin), + "Research Facilities" = as.vector(Research), + "Other" = as.vector(Other) +) + +byAct_multi <- list( + "Nothing Selected" = as.vector('None'), + "Common Favorites" = as.vector(Favorites), + "Academic Buildings" = as.vector(Academic), + "Food and Drinks" = as.vector(Food), + "Wellness" = as.vector(Wellness), + "Student Resources" = as.vector(Resources), + "Administration" = as.vector(Admin), + "Research Facilities" = as.vector(Research), + "Other" = as.vector(Other) +) +####################################### Function for new version of app ################################################# +sun_dat <- rpi_wap_last7 %>% filter(weekday == "Sunday") +mon_dat <- rpi_wap_last7 %>% filter(weekday == "Monday") +tue_dat <- rpi_wap_last7 %>% filter(weekday == "Tuesday") +wed_dat <- rpi_wap_last7 %>% filter(weekday == "Wednesday") +thu_dat <- rpi_wap_last7 %>% filter(weekday == "Thursday") +fri_dat <- rpi_wap_last7 %>% filter(weekday == "Friday") +sat_dat <- rpi_wap_last7 %>% filter(weekday == "Saturday") + +# Function to get map information for leaflet map +get_map_info <- function(dat, hour, hits_per_wap_semester_by_building_max) { + map_info <- dat %>% filter(Hour==hour) %>% + select(lat, lng, BuildingType,Building, users) %>% + group_by(lat, lng, BuildingType,Building) %>% + dplyr::summarise(totalusers = sum(users)) + map_info <- merge(map_info, hits_per_wap_semester_by_building_max, by.x= "Building", by.y="Building") +} + +# Function to get marker color on leaflet map +getColor <- function(dat) { + mapply(function(totalusers, capacity) { + if(totalusers <= 0.25*capacity) {"darkblue"} + else if(totalusers <= 0.5*capacity) {"lightblue"} + else if(totalusers <= 0.75*capacity) {"lightred"} + else {"red"}}, + dat$totalusers, dat$capacity) +} + +# Function to create icon on leaflet map +getIcon <- function(dat){ + icons <- awesomeIcons( + icon = 'ios-close', + iconColor = 'black', + library = 'ion', + markerColor = getColor(dat)) +} + +# Function to generate leaflet map +get_map <- function(dat, lat, lng) { + leaf_map <- leaflet(dat) %>% + addAwesomeMarkers(icon=getIcon(dat)) %>% + addTiles() %>%setView( lng = lng, lat = lat, zoom = 16 ) %>% + addLegend(position = "topleft", colors = c("#235878", "#65b7de", "#f28e80", "#c44130"), labels = c("0% ~ 25%", "25% ~ 50%", "50% ~ 75%", "75% ~ 100%")) +} + +# Function to generate comments on how busy the building is +busy_text <- function(dat, building_select, hits_per_wap_semester_by_building_max){ + building_select_cap <- subset(hits_per_wap_semester_by_building_max, hits_per_wap_semester_by_building_max$Building == building_select) + cap <- dat$users / building_select_cap$capacity + if(cap <= .25){busy_summary <- "usually not busy"} + else if(cap <= .5 & cap > .25){busy_summary <- "usually not too busy"} + else if(cap <= .75 & cap > .5){busy_summary <- "usually a bit busy"} + else {busy_summary <- "usually as busy as it can get"} +} + +# Function to generate capacity line on bar plot +capacity_intercept <- function(capacity){ + c1 <- capacity * .25 + c2 <- capacity * .5 + c3 <- capacity * .75 + cut <- c(c1, c2, c3, capacity) +} + +# Function to make bar plot +make_plot <- function(dat, time_now, building_select, hits_per_wap_semester_by_building_max){ + building_select_cap <- subset(hits_per_wap_semester_by_building_max, hits_per_wap_semester_by_building_max$Building == building_select) + cap_line <- capacity_intercept(building_select_cap$capacity) + ggplot(dat, aes(x=factor(Hour), y=users, fill=(Hour==time_now))) + + geom_bar(stat="identity") + + scale_fill_manual(values=c("skyblue3","mediumvioletred")) + + geom_vline(xintercept = as.integer(time_now)+1, linetype = "dotted") + + geom_hline(yintercept = cap_line, linetype = "dotted") + + scale_x_discrete(labels= Time_AMPM) + + scale_y_continuous(breaks = cap_line, labels = c("25%", "50%", "75%", "100%")) + + ylab("Building Capacity") + + theme(panel.grid.major = element_blank(), + panel.grid.minor = element_blank(), + panel.background = element_blank(), + plot.background = element_blank(), + axis.ticks.y = element_blank(), + axis.ticks.x = element_blank(), + axis.title.x=element_blank(), + legend.position="none") +} + +icon <- awesomeIcons(icon = 'ios-close', iconColor="black", library='ion', markerColor="green") \ No newline at end of file