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/read_wapData.R b/read_wapData.R index db45584a..453cbc1c 100644 --- a/read_wapData.R +++ b/read_wapData.R @@ -29,6 +29,7 @@ library(plotly) library(wesanderson) library(reactable) library(DT) +library(dplyr) ################################################################################################################ ###READING IN NECESSARY FILES @@ -64,6 +65,7 @@ rpi_wap_last7 <- rpi_wap_last7 %>% group_by(Building, Date, Hour, latitude, long 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) @@ -99,7 +101,13 @@ min_time_of_min_date <- min(rpi_wap_last7[rpi_wap_last7$Date == min(rpi_wap_last 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 +sun_building_selected <- reactiveValues(building = 'Amos Eaton') # Remember the name of selected building for future use +mon_building_selected <- reactiveValues(building = 'Amos Eaton') +tue_building_selected <- reactiveValues(building = 'Amos Eaton') +wed_building_selected <- reactiveValues(building = 'Amos Eaton') +thu_building_selected <- reactiveValues(building = 'Amos Eaton') +fri_building_selected <- reactiveValues(building = 'Amos Eaton') +sat_building_selected <- reactiveValues(building = 'Amos Eaton') #weekday information #getting selected weekday