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) { - - #CONSISTENT INPUT SELECTION ACROSS ALL TABS - #Activity Tagging Switch consistent across all tabs - - #Select Building choices dependent on Acitivity Tagging Switch - observe({ - if (input$find_byActivity == FALSE) { - updatePickerInput(session, inputId = "building", choices = byCat_single) - } else { - updatePickerInput(session, inputId = "building", choices = byAct_single) - } - }) - - observe({ - if (input$map_byActivity == FALSE) { - updatePickerInput(session, inputId = 'map_building', choices = byCat_multi) - } else { - updatePickerInput(session, inputId = 'map_building', choices = byAct_multi) - } - }) - - #Now button to current time - observeEvent(input$NOW_find, { - date_app$date <- max_date - time_app$time <- max_time_of_max_date-1 - updateDateInput(session, "date", value = max_date) - updateSelectInput(session, "time", choices = time[1:max_time_of_max_date], selected = max_time_of_max_date-1) - }) - - # Jump to "Quick Compare" - observeEvent(input$jump_to_glance, { - # Switch to "Quick Compare" - newtab <- switch(input$tabs, "find" = "overview","overview" = "find") - updateTabItems(session, "tabs", newtab) - - #Update everything (Date, time, and one of building multi-select) - updateDateInput(session, "overview_date", value = input$date) - updateSelectInput(session, "overview_time", choices = time, selected = input$time) - observe({ - if (input$overview_byActivity == FALSE){ - updatePickerInput(session, "buildingGraph", label = "Building Multiselect", - choices = byCat_single, - selected = input$building) - } else { - updatePickerInput(session, "buildingGraph", label = "Building Multiselect", - choices = byAct_single, - selected = input$building) - } - }) - }) - - observe({ - if (input$overview_byActivity == FALSE){ - updatePickerInput(session, "buildingGraph", label = "Building Multiselect", - choices = byCat_single, - selected = input$building) - } else { - updatePickerInput(session, "buildingGraph", label = "Building Multiselect", - choices = byAct_single, - selected = input$building) - } - }) - - observe({ - # Update the input in the "Find a Place to Study" tab consistently with the other tab - if (input$tabs == 'map' || input$tabs == 'overview') { - updateDateInput(session, "date", value = date_app$date) - updateSelectInput(session, "time", choices = time, selected = time_app$time) - } - # If user chooses minimum date we have, limit time selection range - if (input$date == min_date){ - updateSelectInput(session, "time", choices = time[min_time_of_min_date:length(time)], selected = time_app$time) - } - # If user chooses maximum date we have, limit time selection range - else if (input$date == max_date){ - updateSelectInput(session, "time", choices = time[1:max_time_of_max_date], selected = time_app$time) - } - # If user chooses date between maximum and minimum, then time should not be limited - else if (input$date != max_date & input$date != min_date){ - updateSelectInput(session, "time", choices = time, selected = time_app$time) - } - }) - - counter_find <- reactiveValues(number = -1) # Number of "Update Graphs" button being clicked - - #ABOUT TAB - output$about_body <- renderUI({}) - - #FIND A PLACE TO STUDY TAB - output$find_body <- renderUI({ - - # Observe whether "Update Graphs" button is clicked - observe({ - if (input$submit_find == counter_find$number + 1){ - date_app$date <- input$date - time_app$time <- input$time - building_selected$building <- input$building - counter_find$number <- counter_find$number + 1 - } - }) - - date_select <- date_app$date - time_select <- time_app$time - building_select <- building_selected$building - - - #QUICK SEARCH WELL PANEL - #Piping the data to only have selected building at the selected date and time - quick1_filtered <- rpi_wap_last7 %>% filter(Date == date_select) %>% filter(Building == building_select) - - #Calculations for above or below average compared to the rest of the day for the selected building - aggdf <- aggregate(quick1_filtered$users, by=list(quick1_filtered$Hour),FUN=sum) - colnames(aggdf) <- c('Hour','users') - - aggdf$users[aggdf$users <= 5] <- 0 #making users per building under 5 exluding zero -> 0 - aggdf$users[aggdf$users > 5 & aggdf$users <10 ] <- 10 #making users per building over 5 and under 10 -> 10 - - aggdf$users_z <- round((aggdf$users - mean(aggdf$users))/sd(aggdf$users), 2) # compute normalized hits per wap - aggdf$users_type <- ifelse(aggdf$users_z < 0, "below", "above") # above / below avg flag - - #calculations for above/below average compared to the rest of the buildings at that time - quick2_filtered <- rpi_wap_last7 %>% filter(Date == date_select) %>% filter(Hour == time_select) - aggdf2 <- aggregate(quick2_filtered$users, by=list(quick2_filtered$Building),FUN=sum) - colnames(aggdf2) <- c('Building','users') - - aggdf2$users[aggdf2$users <= 5] <- 0 #making users per building under 5 exluding zero -> 0 - aggdf2$users[aggdf2$users > 5 & aggdf2$users <10 ] <- 10 #making users per building over 5 and under 10 -> 10 - - aggdf2$users_z <- round((aggdf2$users - mean(aggdf2$users))/sd(aggdf2$users), 2) # compute normalized hits per wap - aggdf2$users_type <- ifelse(aggdf2$users_z < 0, "below", "above") # above / below avg flag - - #above/below average summary output - output$title_summary <- renderText({stringr::str_c('On', date_select, 'at', time.data[time.data$Time_num==time_select,]$Time_AMPM,',', building_select, ':', sep = " ")}) - output$AboveBelowAvg1_summary <- renderText({ - if(is.na(sd(aggdf$users))==TRUE){'Has no information about averages compared to earlier in the day at this time.'}else if(building_select %in% hits_per_wap_semester_by_building_max$Building & sd(aggdf$users) != 0 & (time_select %in% aggdf$Hour)){ - stringr::str_c('Has', aggdf[aggdf$Hour == time_select,]$users_type, 'average users compared to earlier in the day', sep = " ") - }else if(building_select %in% hits_per_wap_semester_by_building_max$Building & sd(aggdf$users) == 0){'Has no change in users at all today.'}else{'Has no information about averages compared to earlier in the day at this time.'} - }) - output$AboveBelowAvg2_summary <- renderText({ - if(is.na(sd(aggdf2$users))==TRUE){'Has no information about averages compared to the rest of campus at this time.'}else if(building_select %in% hits_per_wap_semester_by_building_max$Building & sd(aggdf2$users) != 0 & (time_select %in% aggdf$Hour)){ - stringr::str_c('Has', aggdf2[aggdf2$Building==building_select,]$users_type, 'average users compared to the rest of campus.', sep = " ") - }else if(building_select %in% hits_per_wap_semester_by_building_max$Building & sd(aggdf2$users) == 0){'Is no different from the rest of campus.'}else{'Has no information about averages compared to the rest of campus at this time.'} - }) - - if((time_select %in% aggdf$Hour) & (time_select != 0) & ((as.integer(time_select)-1) %in% aggdf$Hour)){ - #Calculating trend by slope over 1 hour for that building at selected hour - trend1 <- aggdf[aggdf$Hour== as.integer(time_select),]$users - trend2 <- aggdf[aggdf$Hour== as.integer(time_select)-1,]$users - trend <- as.integer(trend1)-as.integer(trend2) - - #trend summary output - output$trend_summary <- renderText({ - if(trend>=10){stringr::str_c("Has increased by",abs(trend),"users in the past hour.", sep = " ")}else if(trend<=-10){ - stringr::str_c("Has decreased by",abs(trend),"users in the past hour.", sep = " ")}else{ - stringr::str_c("Has no significant change in the amount of users in the past hour.", sep = " ") - } - - }) - }else{output$trend_summary <- renderText("Has no information about trends at this time.")} - - #calculations for OneBuildingPerHour plot - quick_plot <- rpi_wap_last7 %>% filter(Building == building_select ) %>% filter(Date == date_select) - aggdf3 <- aggregate(quick_plot$users, by=list(quick_plot$Hour, quick_plot$Building),FUN=sum) - colnames(aggdf3) <- c('Hour','Building','users') - aggdf3 <- aggdf3 %>% select(-Building) - - aggdf3$users[aggdf3$users <= 5] <- 0 #making users per building under 5 exluding zero -> 0 - aggdf3$users[aggdf3$users > 5 & aggdf3$users <10 ] <- 10 #making users per building over 5 and under 10 -> 10 - - - #predictions for OneBuildingPerHour plot - if(time_select != 23 & date_select == max_date){ - Hour <- c(max(aggdf3$Hour):23) - users <- rep(c(0), times = length(Hour)) - prediction.template <- data.frame(Hour,users, stringsAsFactors=FALSE) - prediction.template[prediction.template$Hour == max(aggdf3$Hour),]$users <- aggdf3[aggdf3$Hour == max(aggdf3$Hour),]$users - - avg.df <- weekly3_stats %>% filter(Building == building_select) %>% select(-Building) %>% filter(dayVal == wday(date_select)) %>% select(-dayVal) - colnames(avg.df) <- c('Hour', 'users') - - for(i in c(max(aggdf3$Hour):22)){ - prediction.template[prediction.template$Hour == (i+1),]$users <- round((prediction.template[prediction.template$Hour==(i),]$users+ avg.df[avg.df$Hour==(i+1),]$users)/2 ) - } - - }else{ - prediction.template <- data.frame(c(0:23), rep(c(0), times = length(c(0:23))), stringsAsFactors=FALSE) - colnames(prediction.template) <- c('Hour', 'users') - } - - #standard deviation bars - sd_calc <- rpi_wap_last7 %>% filter(Building == building_select) %>% select(Hour,users) - - #shaded rectangles to improve legibility - rect_left <- c(0, 6, 12, 18) - rectangles <- data.frame( - xmin = rect_left, - xmax = rect_left + 3, - ymin = 0, - ymax = Inf - ) - - #OneBuildingPerHour plot output - output$OneBuildingPerHour <- renderPlot ({ - ggplot(aggdf3, aes(x=Hour, y=users))+ - - #Grey Time Blocks - geom_rect(data=rectangles, inherit.aes = F, aes(xmin=xmin, xmax=xmax, ymin=ymin, ymax=ymax), fill='gray80', alpha=0.5) + - - #Line at 0 to help legibility - geom_segment(aes(x= 0 ,xend=23,y=0,yend=0), colour=lightcolor, size=2) + - - geom_histogram(stat="identity", fill = lightcolor, binwidth = .5) + - labs(title="Investigating Where to go", subtitle=stringr::str_c(building_select, " on ", date_select, " at ", time.data[time.data$Time_num==time_select,]$Time_AMPM ), y="Users", x = 'Time of Day',color=NULL) + - scale_y_continuous(expand = expansion(mult = c(0, .1))) + - scale_x_continuous(breaks= seq(0,23,1), labels=time.data$Time_noLabel) + - - #Dark Blue Rectangle indicating selected Hour - geom_rect(fill = darkcolor, xmin = as.integer(time_select)-0.45, xmax = as.integer(time_select)+0.45, ymin = 0, ymax = aggdf3$users[as.integer(time_select)+1]) + - - #Line indicating Max users - geom_hline(yintercept = hits_per_wap_semester_by_building_max[hits_per_wap_semester_by_building_max$Building==building_select,]$capacity, linetype = "dotted") + - annotate(geom="text", label= 'Max Users this Semester', x=11.5, y=hits_per_wap_semester_by_building_max[hits_per_wap_semester_by_building_max$Building==building_select,]$capacity, colour = "gray30",vjust=-0.5) + - geom_vline(xintercept = as.integer(time_select), size = 1.25, colour = '#54585a') + - - #Adding bars of predicted data - geom_histogram(data = prediction.template[prediction.template$Hour>max(aggdf3$Hour),] , stat="identity", fill ="#FAFAFA", color = lightcolor, binwidth = .5) + - - #Adding standard deviation error bars to predictive data - geom_errorbar(data = prediction.template[prediction.template$Hour>max(aggdf3$Hour),], aes(x=Hour, y=users, ymin = users, - ymax=users+sd(sd_calc[sd_calc$Hour %in% Hour,]$users)), colour=lightcolor, alpha=1, size=.8) + - #Theme - theme_bw() + theme(plot.background = element_blank(), - plot.title = element_text(family = 'Source Sans Pro', face = 'bold', lineheight = 6, size = 14, hjust = .5, color = '#d6001c', margin= margin( b = 8)), - plot.subtitle = element_text(family = 'Source Sans Pro', face = 'plain', size = 12, hjust = .5, color = '#54585a'), - axis.title = element_text(family = 'Source Sans Pro', face = 'plain', size = 12, hjust = .5, color = '#54585a') - ) - - }, bg="transparent") - - #is the building near capacity for the selected time calculations - capacities <- hits_per_wap_semester_by_building_max %>% filter(Building==building_select) - cap_recommend <- aggdf - cap_recommend$users_action <- ifelse(cap_recommend$users <= .75*capacities$capacity, "below 75% maximum ", "near or above 75% maximum ") # above / below avg flag - cap_recommend$users_calc <- ifelse(cap_recommend$users <= .5*capacities$capacity, "below 50%", "above 50%") # above / below avg flag - - #near capacity test output statement - output$capacity_summary <- renderText({ - if(building_select %in% hits_per_wap_semester_by_building_max$Building & (time_select %in% aggdf$Hour) ){ - stringr::str_c('Is ', cap_recommend[cap_recommend$Hour==time_select,]$users_action, '(about ', round(100*(cap_recommend[cap_recommend$Hour==time_select,]$users)/ capacities[capacities$Building==building_select,]$capacity,2) ,'% full).',sep = "") - }else{'Has no information about capacity for this building at this time'} - }) - - #recommendation calculations - recnum <- 0 - if(building_select %in% hits_per_wap_semester_by_building_max$Building){ - - if(cap_recommend[cap_recommend$Hour==time_select,]$users_action=='below 75% maximum ' & (time_select %in% aggdf$Hour)){recnum <- recnum + 1}else if(cap_recommend[cap_recommend$Hour==time_select,]$users_action=="near or above 75% maximum " & (time_select %in% aggdf$Hour)){recnum <- recnum - 1}else{} - if(cap_recommend[cap_recommend$Hour==time_select,]$users_calc=='below 50%' & (time_select %in% aggdf$Hour)){}else if(cap_recommend[cap_recommend$Hour==time_select,]$users_calc=="above 50%" & (time_select %in% aggdf$Hour)){recnum <- recnum - 0.5}else{} - if(is.na(sd(aggdf$users))==TRUE){}else if(sd(aggdf$users)==0){recnum <- recnum}else if(aggdf[aggdf$Hour==time_select,]$users_type=='above' & (time_select %in% aggdf$Hour)){recnum <- recnum - 0.75}else if(aggdf[aggdf$Hour==time_select,]$users_type=='below' & (time_select %in% aggdf$Hour)){recnum <- recnum + 0.75}else{} - if(is.na(sd(aggdf2$users))==TRUE){}else if(sd(aggdf2$users)==0){recnum <- recnum}else if(aggdf2[aggdf2$Building==building_select,]$users_type=='above' & (time_select %in% aggdf$Hour)){recnum <- recnum - 0.25}else if(aggdf2[aggdf2$Building==building_select,]$users_type=='below' & (time_select %in% aggdf$Hour)){recnum <- recnum + 0.25}else{} - - }else{} - - if((time_select %in% aggdf$Hour) & ((as.integer(time_select)-1) %in% aggdf$Hour) & (time_select != 0)){ - if(trend>=10){renum<-recnum - 0.5}else{recnum <- recnum + 0.5} - }else{} - - #recommendation text output - output$SmileFrown_summary <- renderText({ - if((time_select %in% aggdf$Hour) & recnum>1){ - "This might be a good spot!" - }else if((time_select %in% aggdf$Hour) & recnum<0){"This might not be a good spot right now."} - else{'This may or may not be a good spot, maybe consider somewhere else first!'} - }) - - #image output depending on reccommendation calculations - output$SmileFrown_image <- renderImage({ - if((time_select %in% aggdf$Hour) & recnum>1){ - filename <- normalizePath(file.path('images', paste('WithoutBlue', '.png', sep=''))) - }else if((time_select %in% aggdf$Hour) & recnum<0){ filename <- normalizePath(file.path('images', paste('WithoutRed2', '.png', sep='')))} - else{filename <- normalizePath(file.path('images', paste('WithoutOrange2', '.png', sep='')))} - - list(src = filename, - alt = "This is alternate text for the image (smile or frown) representing the reccommendation sentence") - },deleteFile = FALSE) - - - }) - - # "Google" Tab ################################################################################################################################################### - - observe({ - weekday_now <- weekdays(Sys.Date()) - updateTabsetPanel(session,"week_tab", selected = weekday_now) - }) - - output$week_view <- renderUI({ - weekday_now <- weekdays(Sys.Date()) - observe({ - building_selected$building <- input$building - }) - building_select <- building_selected$building - - sun_dat <- rpi_wap_last7 %>% filter(weekday == "Sunday") %>% filter(Building == building_select) - mon_dat <- rpi_wap_last7 %>% filter(weekday == "Monday") %>% filter(Building == building_select) - tue_dat <- rpi_wap_last7 %>% filter(weekday == "Tuesday") %>% filter(Building == building_select) - wed_dat <- rpi_wap_last7 %>% filter(weekday == "Wednesday") %>% filter(Building == building_select) - thu_dat <- rpi_wap_last7 %>% filter(weekday == "Thursday") %>% filter(Building == building_select) - fri_dat <- rpi_wap_last7 %>% filter(weekday == "Friday") %>% filter(Building == building_select) - sat_dat <- rpi_wap_last7 %>% filter(weekday == "Saturday") %>% filter(Building == building_select) - - 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 >= .25 & cap < .5){ - busy_summary <- "usually not too busy" - } else if(cap >= .5 & cap < .75){ - busy_summary <- "usually a bit busy" - } else { - busy_summary <- "usually as busy as it can get" - } - } - - all_time <- unique(sun_dat$Hour) - - capacity_intercept <- function(capacity){ - c1 <- capacity * .25 - c2 <- capacity * .5 - c3 <- capacity * .75 - cut <- c(c1, c2, c3, capacity) - } - - 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% capacity", "50% capacity", "75% capacity", "100% 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.text.y=element_blank(), - axis.title.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 - }) - - observe({ - time_now <- as.integer(format(Sys.time(), "%H")) - if (is.null(sun_react_click$Clicks)){ - sun_hr_dat <- sun_dat[time_now+1,] - hr_pick_plot <- make_plot(sun_dat, time_now, building_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) - output$sun_plot <- renderPlot({hr_pick_plot}, bg="transparent") - output$sun_info <- renderUI({p("At", as.numeric(sun_hr_dat$Hour), ":00", "it is", output_text)}) - } else { - sun_hr_dat <- sun_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) - hr_pick_plot <- make_plot(sun_dat, time_now, building_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", "it 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 - }) - - observe({ - time_now <- as.integer(format(Sys.time(), "%H")) - if (is.null(mon_react_click$Clicks)){ - mon_hr_dat <- mon_dat[time_now+1,] - hr_pick_plot <- make_plot(mon_dat, time_now, building_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) - output$mon_plot <- renderPlot({hr_pick_plot}, bg="transparent") - output$mon_info <- renderUI({p("At", as.numeric(mon_hr_dat$Hour), ":00", "it is", output_text)}) - } else { - mon_hr_dat <- mon_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(mon_react_click$Clicks) - hr_pick_plot <- make_plot(mon_dat, time_now, building_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", "it 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 - }) - - observe({ - time_now <- as.integer(format(Sys.time(), "%H")) - if (is.null(tue_react_click$Clicks)){ - tue_hr_dat <- tue_dat[time_now+1,] - hr_pick_plot <- make_plot(tue_dat, time_now, building_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) - output$tue_plot <- renderPlot({hr_pick_plot}, bg="transparent") - output$tue_info <- renderUI({p("At", as.numeric(tue_hr_dat$Hour), ":00", "it is", output_text)}) - } else { - tue_hr_dat <- tue_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) - hr_pick_plot <- make_plot(tue_dat, time_now, building_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", "it 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 - }) - - observe({ - time_now <- as.integer(format(Sys.time(), "%H")) - if (is.null(wed_react_click$Clicks)){ - wed_hr_dat <- wed_dat[time_now+1,] - hr_pick_plot <- make_plot(wed_dat, time_now, building_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) - output$wed_plot <- renderPlot({hr_pick_plot}, bg="transparent") - output$wed_info <- renderUI({p("At", as.numeric(wed_hr_dat$Hour), ":00", "it is", output_text)}) - } else { - wed_hr_dat <- wed_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) - hr_pick_plot <- make_plot(wed_dat, time_now, building_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", "it 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 - }) - - observe({ - time_now <- as.integer(format(Sys.time(), "%H")) - if (is.null(thu_react_click$Clicks)){ - thu_hr_dat <- thu_dat[time_now+1,] - hr_pick_plot <- make_plot(thu_dat, time_now, building_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) - output$thu_plot <- renderPlot({hr_pick_plot}, bg="transparent") - output$thu_info <- renderUI({p("At", as.numeric(thu_hr_dat$Hour), ":00", "it is", output_text)}) - } else { - thu_hr_dat <- thu_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) - # browser() - hr_pick_plot <- make_plot(thu_dat, time_now, building_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", "it 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 - }) - - observe({ - time_now <- as.integer(format(Sys.time(), "%H")) - if (is.null(fri_react_click$Clicks)){ - fri_hr_dat <- fri_dat[time_now+1,] - hr_pick_plot <- make_plot(fri_dat, time_now, building_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) - output$fri_plot <- renderPlot({hr_pick_plot}, bg="transparent") - output$fri_info <- renderUI({p("At", as.numeric(fri_hr_dat$Hour), ":00", "it is", output_text)}) - } else { - fri_hr_dat <- fri_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) - hr_pick_plot <- make_plot(fri_dat, time_now, building_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", "it 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 - }) - - observe({ - time_now <- as.integer(format(Sys.time(), "%H")) - if (is.null(sat_react_click$Clicks)){ - sat_hr_dat <- sat_dat[time_now+1,] - hr_pick_plot <- make_plot(sat_dat, time_now, building_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) - output$sat_plot <- renderPlot({hr_pick_plot}, bg="transparent") - output$sat_info <- renderUI({p("At", as.numeric(sat_hr_dat$Hour), ":00", "it is", output_text)}) - } else { - sat_hr_dat <- sat_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) - hr_pick_plot <- make_plot(sat_dat, time_now, building_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", "it is", output_text)}) - } - }) - - }) - - - #QUICK COMPARE TAB - #Now button to current time - observeEvent(input$NOW_overview, { - date_app$date <- max_date - time_app$time <- max_time_of_max_date-1 - updateDateInput(session, "overview_date", value = max_date) - updateSelectInput(session, "overview_time", choices = time, selected = max_time_of_max_date-1) - }) - - observeEvent(input$jump_to_glance, { - date_select = input$overview_date - time_select = input$overview_time - buildings_select = input$buildingGraph - }) - - observe({ - # Update the input in the "Quick Compare" tab consistently with the other tab - if (input$tabs == 'find' || input$tabs == 'map') { - updateDateInput(session, "overview_date", value = date_app$date) - updateSelectInput(session, "overview_time", choices = time, selected = time_app$time) - } - # If user chooses minimum date we have, restrict time selection range - if (input$overview_date == min_date){ - updateSelectInput(session, "overview_time", choices = time[min_time_of_min_date:length(time)], selected = date_app$date) - } - # If user chooses maximum date we have, restrict time selection range - else if (input$overview_date == max_date){ - updateSelectInput(session, "overview_time", choices = time[1:max_time_of_max_date], selected = time_app$time) - } - # If user chooses date between maximum and minimum, then time should not be constrained - else if (input$overview_date != max_date & input$overview_date != min_date){ - updateSelectInput(session, "overview_time", choices = time, selected = time_app$time) - } - }) - - #The remaining body - output$overview_body <-renderUI({ - - # When first open it, nothing to show - if (input$submit_campus == 0 & is.null(input$jump_to_glance)) - return(NULL) - - # Isolate updating inputs so that the graph will update only if user clicks "Update Graphs" - isolate({ - date_app$date <- input$overview_date - time_app$time <- input$overview_time - buildings_select <- input$buildingGraph - }) - - date_select <- date_app$date - time_select <- time_app$time - - #Wes Anderson "Darjeeling1" Palette - pal <- wes_palette("Darjeeling1", length(buildings_select), type = "continuous") - - #calculations for multipleBuildingPerHour plot - multi_plot <- rpi_wap_last7 %>% filter(Building %in% buildings_select) %>% filter(Date == date_select) - aggdf4 <- aggregate(multi_plot$users, by=list(multi_plot$Hour, multi_plot$Building),FUN=sum) - colnames(aggdf4) <- c('Hour','Building','users') - - aggdf4$users[aggdf4$users <= 5] <- 0 #making users per building under 5 exluding zero -> 0 - aggdf4$users[aggdf4$users > 5 & aggdf4$users <10 ] <- 10 #making users per building over 5 and under 10 -> 10 - - - cap_select <- hits_per_wap_semester_by_building_max %>% filter(Building %in% buildings_select) - aggdf4$percentage <- 0 - for(building in cap_select$Building){ - for(i in 0:23){ - aggdf4[aggdf4$Hour== i & aggdf4$Building==building, ]$percentage <- 100*(aggdf4[aggdf4$Hour== i & aggdf4$Building==building, ]$users/cap_select[cap_select$Building==building,]$capacity) - } - } - - #shaded rectangles to improve legibility - rect_left <- c(0, 6, 12, 18) - rectangles <- data.frame( - xmin = rect_left, - xmax = rect_left + 3, - ymin = 0, - ymax = Inf - ) - - #Multiple Building per Hour Plot - output$multipleBuildingPerHour <- renderPlot({ - ggplot(aggdf4, aes(x=Hour)) + - #Grey Time Blocks - geom_rect(data=rectangles, inherit.aes = F, - aes(xmin=xmin, xmax=xmax, ymin=ymin, ymax=ymax), - fill='gray80', alpha=0.2) + - geom_line(aes(y=percentage, col=Building)) + scale_color_brewer(palette = "RdYlBu")+ - labs(title= "Investigating Where to Go", - subtitle=paste("Selected Buildings on", date_select, "at", time.data[time.data$Time_num==time_select,]$Time_AMPM ), - y="Percentage of Maximum Users", x = "Time of Day", - color=NULL) + scale_x_continuous(breaks= seq(0,23,1), labels=time.data$Time_noLabel) + scale_y_continuous(breaks= seq(0,100,5)) + - geom_vline(xintercept = as.integer(time_select), size = 1.25, colour = '#54585a') + - scale_color_manual(values = pal) + - - #Theme - theme_bw() + theme(plot.background = element_blank(), - plot.title = element_text(family = 'Source Sans Pro', face = 'bold', lineheight = 6, size = 14, hjust = .5, color = '#d6001c', margin= margin( b = 8)), - plot.subtitle = element_text(family = 'Source Sans Pro', face = 'plain', size = 12, hjust = .5, color = '#54585a'), - axis.title = element_text(family = 'Source Sans Pro', face = 'plain', size = 12, hjust = .5, color = '#54585a'), - legend.background = element_blank(), - legend.position = "bottom", - legend.text = element_text(family = 'Source Sans Pro', face = 'plain', color = '#54585a') - ) - }, bg = "transparent") - - - # Select the specific hour (user input) data out - Builings_specific_hour2 <- aggdf4[aggdf4$Hour == time_select,] - - # The data frame of maximum urses of every building for this semester - Buildings_selected_capacity <- hits_per_wap_semester_by_building_max[hits_per_wap_semester_by_building_max$Building %in% Builings_specific_hour2$Building,] - - # Combine maximum urses(capacity here) of each building and the data we have - Builings_specific_hour <- cbind(Builings_specific_hour2, capacity = rep(0,nrow(Builings_specific_hour2))) - Builings_specific_hour$capacity[Builings_specific_hour$Building %in% Buildings_selected_capacity$Building] <- Buildings_selected_capacity$capacity - - # Split into two data frames in order to draw two histograms(one is capacity, the other is number of users now) in one graph - true_users <- data.frame(Building = Builings_specific_hour$Building, users = Builings_specific_hour$users) - max_capacity <- data.frame(Building = Builings_specific_hour$Building, users = Builings_specific_hour$capacity) - - # Plot the histogram graph - output$multipleBuildinghistogram <- renderPlot({ - - ggplot(Builings_specific_hour,aes(x = Building, y = users, color = as.factor(Building), fill = as.factor(Building))) + - geom_histogram(data = true_users, stat='identity', alpha=0.6) + geom_histogram(data = max_capacity, fill = 'white', stat='identity', alpha=0.6, label = TRUE) + - geom_text(aes(label = percent(users/capacity)), position = position_stack(vjust = 1), size=5) + - labs(title="Investigating Where to Go", - subtitle=paste("Selected Buildings on", date_select, "at", time.data[time.data$Time_num==time_select,]$Time_AMPM ), - y="Users Compared to Maximum", x = "Selected Buildings", - color = 'Buildings', - fill = 'Buildings' - ) + - scale_color_manual(values = pal) + scale_fill_manual(values = pal) + - - #Theme - theme_bw() + theme(plot.background = element_blank(), - plot.title = element_text(family = 'Source Sans Pro', face = 'bold', lineheight = 6, size = 14, hjust = .5, color = '#d6001c', margin= margin( b = 8)), - plot.subtitle = element_text(family = 'Source Sans Pro', face = 'plain', size = 12, hjust = .5, color = '#54585a'), - axis.title = element_text(family = 'Source Sans Pro', face = 'plain', size = 12, hjust = .5, color = '#54585a'), - legend.background = element_blank(), - legend.position = "bottom", - legend.text = element_text(family = 'Source Sans Pro', face = 'plain', color = '#54585a'), - legend.title = element_blank() - ) - }, bg = "transparent") - - }) - - - #MAP TAB BODY - counter_map <- reactiveValues(number = -1) # Number of "Update Graphs" button being clicked - - #Now button to current time - observeEvent(input$NOW_map, { - date_app$date <- max_date - time_app$time <- max_time_of_max_date-1 - updateDateInput(session, "map_date", value = max_date) - updateSelectInput(session, "map_time", choices = time[1:max_time_of_max_date], selected = max_time_of_max_date-1) - }) - - observe({ - # Update the input in the "Map" tab consistently with the other tab - if (input$tabs == 'find' || input$tabs == 'overview') { - updateDateInput(session, "map_date", value = date_app$date) - updateSelectInput(session, "map_time", choices = time, selected = time_app$time) - } - # If user chooses minimum date we have, restrict time selection range - if (input$map_date == min_date){ - updateSelectInput(session, "map_time", choices = time[min_time_of_min_date:length(time)], selected = time_app$time) - } - # If user chooses maximum date we have, restrict time selection range - else if (input$map_date == max_date){ - updateSelectInput(session, "map_time", choices = time[1:max_time_of_max_date], selected = time_app$time) - } - # If user chooses date between maximum and minimum, then time should not be constrained - else if (input$map_date != max_date & input$map_date != min_date){ - updateSelectInput(session, "map_time", choices = time, selected = time_app$time) - } - }) - - #The remaining body - jump_find <- 'no' # Jump to "Find a Place to Study" when this jump = 'yes' - building_map <- reactiveValues(building = 'none') # Temporarily remember the name of building that is clicked - - output$map_body <- renderUI({ - - # Observe whether "Update Graphs" button is clicked - observe({ - if (input$submit_map == counter_map$number + 1){ - - date_app$date <- input$map_date - time_app$time <- input$map_time - counter_map$number <- counter_map$number + 1 - } - }) - - date_select <- date_app$date - time_select <- time_app$time - MTpreference <- input$displaySelect - - #Title output - output$MT_title_summary <- renderText({ - stringr::str_c("RPI on ", date_select,' at ', time.data[time.data$Time_num==time_select,]$Time_AMPM) - }) - - #Creating a data set for the map and table - map_merge_filtered <- rpi_wap_last7 %>% filter(Date == date_select) %>% filter(Hour==time_select) %>% - select(lat, lng, BuildingType,Building, users) %>% group_by(lat, lng, BuildingType,Building) %>% dplyr::summarise(totalusers = sum(users)) - - map_merge_filtered$totalusers[map_merge_filtered$totalusers <= 5] <- 0 #making users per building under 5 exluding zero -> 0 - map_merge_filtered$totalusers[map_merge_filtered$totalusers > 5 & map_merge_filtered$totalusers <10 ] <- 10 #making users per building over 5 and under 10 -> 10 - - # Combine our data with capacity - map_merge_filtered2 <- merge(map_merge_filtered, hits_per_wap_semester_by_building_max, by.x= "Building", by.y="Building") - map_merge_filteredT <- map_merge_filtered2 - - # If user select a building, then remember info of that building as building_map_select and delete it from map_merge_filtered2 - if (input$map_building != 'None'){ - building_map_select <- map_merge_filtered2[map_merge_filtered2$Building == input$map_building,] - map_merge_filtered2 <- map_merge_filtered2[-c(which(map_merge_filtered2$Building == input$map_building)),] - } - - # Get color of marker according to percentage of "capacity" - getColor <- function(map_merge_filtered2) { - mapply(function(totalusers, capacity) { - if(totalusers <= 0.25*capacity) { - "lightblue" - #"#1f6798" #light blue - } else if(totalusers <= 0.5*capacity) { - "beige" - #"#00205b" #dark blue - } else if(totalusers <= 0.75*capacity) { - "lightred" - #"#333366" #purple - }else { - "red" - #"#990000" #red - } }, map_merge_filtered2$totalusers, map_merge_filtered2$capacity - ) - } - - icons <- awesomeIcons( - icon = 'ios-close', - iconColor = 'black', - library = 'ion', - markerColor = getColor(map_merge_filtered2) - ) - - #Hiding whichever display is not selected, map or table - observeEvent(MTpreference, { - if(MTpreference=='Map'){ - hideElement(id = 'mytable', anim = FALSE) - showElement(id = 'mymap') - }else if(MTpreference == 'Table'){ - hideElement(id = 'mymap', anim = FALSE) - showElement(id = 'mytable') - } - }) - - #creating table - #Add percentage column - map_merge_filteredT$percentage <- percent(map_merge_filteredT$totalusers/map_merge_filteredT$capacity) - - # Copy the dataframe map_merge_filteredT to another dataframe map_merge_filteredT_2 - map_merge_filteredT_2 <- map_merge_filteredT - - # shinyInput function to make action links - shinyInput <- function(FUN, len, id, label, ...) { - inputs <- character(len) - - for (i in seq_len(len)) { - label <- map_merge_filteredT$Building[i] - inputs[i] <- as.character(FUN(paste0(id, i),label=label, ...)) - } - inputs - } - - # Add action links to Buildings' name - map_merge_filteredT <- map_merge_filteredT %>% - mutate(Building = shinyInput(actionLink, nrow(map_merge_filteredT), 'button_', label = Building, onclick = 'Shiny.onInputChange(\"jump_to_find_table\", this.id)' )) - - output$mytable <- renderReactable({ - reactable( - map_merge_filteredT, - #groupBy = "BuildingType", - pagination = FALSE, - height = 750, - #paginationType = "jump", - #showPageSizeOptions = TRUE, - #pageSizeOptions = c(5, 10, 25, 50, 100), - highlight = TRUE, - outlined = TRUE, - bordered = TRUE, - striped = TRUE, - compact = TRUE, - wrap = TRUE, - showSortable = TRUE, - resizable = TRUE, - searchable = TRUE, - style = 'color: black; background-color:#FAFAFA; font-family: Source Sans Pro;', - defaultSortOrder = "desc", - - #highlighting a row if searched using input select - rowStyle = function(index) { - if (map_merge_filteredT_2[index, "Building"] == input$map_building) { - list(background = '#9ea2a2')}}, - - #listing BuildingType under Building names - columns = list( - - Building = colDef( - - style = 'text-align: left;', - # Show BuildingType under Building names - cell = JS("function(cellInfo) { - var BuildingType = cellInfo.row['BuildingType'] || 'Unknown' - return ( - '
Place of Selection 
Place of Selection 
Place of Selection 
Place of Selection 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/README.md b/README.md index ecdaf0cf..434a4737 100644 --- a/README.md +++ b/README.md @@ -5,7 +5,7 @@ The notes below are meant to be used for cloning the repo and code contributions ## About StudySafe StudySafe is a web application built on the R Shiny application framework, written primarily in R, with some UI functionality written in Javascript and HTML. It creates highly visual analysis of campus population data provided by RPI. You will find live versions of the app at the following locations: -Application Website: https://studysafe.idea.rpi.edu/ +Application Website: https://inciteprojects.idea.rpi.edu/apps/studysafe/ Application Github Repository: https://github.rpi.edu/DataINCITE/IDEA-COVID-StudySafe @@ -48,4 +48,4 @@ Found a bug? Please create an issue titled as a clear sentence describing the bu - The size of the StudySafe app window - What StudySafe page did the bug appear on? - What date/time/building/type of building/floor did the bug occur on, if applicable were selected when bug was found? -- Any other information you may deem relevant to said bug \ No newline at end of file +- Any other information you may deem relevant to said bug diff --git a/buildinghoursAccessInfo.csv b/buildinghoursAccessInfo.csv new file mode 100644 index 00000000..5d18342a --- /dev/null +++ b/buildinghoursAccessInfo.csv @@ -0,0 +1,41 @@ +Building,Mode,TimeZone +41 9th?Street,Community Access,7AM-9PM Weekdays +1516 People?s Ave,Locked/Closed,24/7 +87 Gym,Locked/Closed,24/7 +Academy Hall,Community Access,7AM-9PM Weekdays +Admissions Building,Community Access: being installed,9A-5P Weekdays +Amos Eaton,Community Access: being installed,7AM-9PM Weekdays +AS&RC,Locked/Closed,24/7 +Bar-H Dining Hall,Community Access (with meal plan),7:15AM-9PM Daily +Biotech,Locked/Closed,24/7 +Blitman Dining,Community Access (with meal plan),"7A-8P Weekdays, 8A-8P Sat/Sun" +Carnergie,Community Access: being installed,7AM-9PM Weekdays +CII,Community Access,7AM-9PM Weekdays +Cogswell,Community Access,7AM-6PM Weekdays +Commons Dining Hall,Community Access: Being installed,"7A-8P Weekdays, 8A-8P Sat/Sun" +DCC,Community Access: Being installed,7AM-9PM Weekdays +ECAV,Locked/Closed,24/7 +Empire,Community Access,24/7 +Empac,Locked/Closed,24/7 +Folsom Library,Community Access,"9AM-Midnight Monday-Thursday, 9AM-7PM Friday, 12PM-8PM Saturday,???? 2PM-10PM Sunday" +Greene Building,Locked/Closed,24/7 +Heffner Alumni House,Locked/Closed,24/7 +J-Building,Locked/Closed,24/7 +JEC,Community Access: Being installed,7AM-9PM Weekdays +Lally,Community Access: Being installed,7AM-9PM Weekdays +Linac/NES,Locked/Closed,24/7 +MRC,Community Access,7AM-6PM Weekdays +Mueller,Locked/Closed,24/7 +Off Campus Commons,Locked/Closed,24/7 +Playhouse,Locked/Closed,24/7 +Pittsburgh Building,Community Access: Being installed,7AM-9PM Weekdays +Ricketts,Community Access: Being installed,7AM-9PM Weekdays +Sage Dining Hall,Community Access: Being installed,"7A-8P Weekdays, 8A-8P Sat/Sun" +Sage Lab,Locked/Closed,24/7 +Science Center,Community Access: Being installed,7AM-9PM Weekdays +Student Transition Building,Community Access: Being installed,7AM-9PM Weekdays +Student Union,Community Access,"8AM-11:30PM Weekdays, 10AM-5:30PM Saturday, 12PM-7:30PM Sunday" +Troy Building,Locked/Closed,24/7 +VCC,Community Access,7:30AM-11:30PM Daily +Walker Lab,Community Access: being Installed,7A-9P Weekdays +West Hall,Community Access,7AM-Midnight Daily