")),
+ tabsetPanel(id = "week_tab",
+ tabPanel("Sunday", tabName="sunday", br(),
+ tags$style(type = "text/css", "#sunMap {height: calc(100vh - 80px) !important;}"),
+ leafletOutput("sunMap"), br(),
+ absolutePanel(id = "controls", class = "panel panel-default", fixed = TRUE,
+ draggable = TRUE, top = 60, left = "auto", right = 20, bottom = "auto",
+ width = "30vw", height = "auto",
+ h2("Find a Place to Study"),
+ pickerInput(inputId = 'sun_selected', label = tags$div(HTML("Choose a Building")),
+ options = list(`live-search` = TRUE),
+ choices = byCat_single),
+ prettySwitch(inputId = 'byActivity', inline = TRUE,
+ label= tags$div(HTML("List by Activity")),
+ value = FALSE, status = "default", fill = TRUE, bigger = TRUE),
+ uiOutput("sun_info", align = "center"),
+ br(), plotOutput("sun_plot", click = "sun_click"))),
+ tabPanel("Monday", tabName="monday", br(),
+ tags$style(type = "text/css", "#monMap {height: calc(100vh - 80px) !important;}"),
+ leafletOutput("monMap"), br(),
+ absolutePanel(id = "controls", class = "panel panel-default", fixed = TRUE,
+ draggable = TRUE, top = 60, left = "auto", right = 20, bottom = "auto",
+ width = "30vw", height = "auto",
+ h2("Find a Place to Study"),
+ pickerInput(inputId = 'mon_selected', label = tags$div(HTML("Choose a Building")),
+ options = list(`live-search` = TRUE),
+ choices = byCat_single),
+ prettySwitch(inputId = 'byActivity', inline = TRUE,
+ label= tags$div(HTML("List by Activity")),
+ value = FALSE, status = "default", fill = TRUE, bigger = TRUE),
+ uiOutput("mon_info", align = "center"),
+ br(), plotOutput("mon_plot", click = "mon_click"))),
+ tabPanel("Tuesday", tabName="tuesday", br(),
+ tags$style(type = "text/css", "#tueMap {height: calc(100vh - 80px) !important;}"),
+ leafletOutput("tueMap"), br(),
+ absolutePanel(id = "controls", class = "panel panel-default", fixed = TRUE,
+ draggable = TRUE, top = 60, left = "auto", right = 20, bottom = "auto",
+ width = "30vw", height = "auto",
+ h2("Find a Place to Study"),
+ pickerInput(inputId = 'tue_selected', label = tags$div(HTML("Choose a Building")),
+ options = list(`live-search` = TRUE),
+ choices = byCat_single),
+ prettySwitch(inputId = 'byActivity', inline = TRUE,
+ label= tags$div(HTML("List by Activity")),
+ value = FALSE, status = "default", fill = TRUE, bigger = TRUE),
+ uiOutput("tue_info", align = "center"),
+ br(), plotOutput("tue_plot", click = "tue_click"))),
+ tabPanel("Wednesday", tabName="wednesday", br(),
+ tags$style(type = "text/css", "#wedMap {height: calc(100vh - 80px) !important;}"),
+ leafletOutput("wedMap"), br(),
+ absolutePanel(id = "controls", class = "panel panel-default", fixed = TRUE,
+ draggable = TRUE, top = 60, left = "auto", right = 20, bottom = "auto",
+ width = "30vw", height = "auto",
+ h2("Find a Place to Study"),
+ pickerInput(inputId = 'wed_selected', label = tags$div(HTML("Choose a Building")),
+ options = list(`live-search` = TRUE),
+ choices = byCat_single),
+ prettySwitch(inputId = 'byActivity', inline = TRUE,
+ label= tags$div(HTML("List by Activity")),
+ value = FALSE, status = "default", fill = TRUE, bigger = TRUE),
+ uiOutput("wed_info", align = "center"),
+ br(), plotOutput("wed_plot", click = "wed_click"))),
+ tabPanel("Thursday", tabName="thursday", br(),
+ tags$style(type = "text/css", "#thuMap {height: calc(100vh - 80px) !important;}"),
+ leafletOutput("thuMap"), br(),
+ absolutePanel(id = "controls", class = "panel panel-default", fixed = TRUE,
+ draggable = TRUE, top = 60, left = "auto", right = 20, bottom = "auto",
+ width = "30vw", height = "auto",
+ h2("Find a Place to Study"),
+ pickerInput(inputId = 'thu_selected', label = tags$div(HTML("Choose a Building")),
+ options = list(`live-search` = TRUE),
+ choices = byCat_single),
+ prettySwitch(inputId = 'byActivity', inline = TRUE,
+ label= tags$div(HTML("List by Activity")),
+ value = FALSE, status = "default", fill = TRUE, bigger = TRUE),
+ uiOutput("thu_info", align = "center"),
+ br(), plotOutput("thu_plot", click = "thu_click"))),
+ tabPanel("Friday", tabName="friday", br(),
+ tags$style(type = "text/css", "#friMap {height: calc(100vh - 80px) !important;}"),
+ leafletOutput("friMap"), br(),
+ absolutePanel(id = "controls", class = "panel panel-default", fixed = TRUE,
+ draggable = TRUE, top = 60, left = "auto", right = 20, bottom = "auto",
+ width = "30vw", height = "auto",
+ h2("Find a Place to Study"),
+ pickerInput(inputId = 'fri_selected', label = tags$div(HTML("Choose a Building")),
+ options = list(`live-search` = TRUE),
+ choices = byCat_single),
+ prettySwitch(inputId = 'byActivity', inline = TRUE,
+ label= tags$div(HTML("List by Activity")),
+ value = FALSE, status = "default", fill = TRUE, bigger = TRUE),
+ uiOutput("fri_info", align = "center"),
+ br(), plotOutput("fri_plot", click = "fri_click"))),
+ tabPanel("Saturday", tabName="saturday", br(),
+ tags$style(type = "text/css", "#satMap {height: calc(100vh - 80px) !important;}"),
+ leafletOutput("satMap"), br(),
+ absolutePanel(id = "controls", class = "panel panel-default", fixed = TRUE,
+ draggable = TRUE, top = 60, left = "auto", right = 20, bottom = "auto",
+ width = "30vw", height = "auto",
+ h2("Find a Place to Study"),
+ pickerInput(inputId = 'sat_selected', label = tags$div(HTML("Choose a Building")),
+ options = list(`live-search` = TRUE),
+ choices = byCat_single),
+ prettySwitch(inputId = 'byActivity', inline = TRUE,
+ label= tags$div(HTML("List by Activity")),
+ value = FALSE, status = "default", fill = TRUE, bigger = TRUE),
+ uiOutput("sat_info", align = "center"),
+ br(), plotOutput("sat_plot", click = "sat_click")))))
),
#USING THE CSS FILE ARIELLE DEVELOPED
@@ -326,770 +261,495 @@ ui <- dashboardPage(skin = "black", title = "RPI StudySafe",
)
-
)
# Define server logic required
server <- function(input, output, session) {
- #CONSISTENT INPUT SELECTION ACROSS ALL TABS
- #Activity Tagging Switch consistent across all tabs
+ #ABOUT TAB
+ output$about_body <- renderUI({})
- #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)
- }
- })
+ # "Google" Tab ###################################################################################################################################################
+ # Set default tab to today's weekday
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)
- }
- })
+ 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$overview_byActivity == FALSE){
- updatePickerInput(session, "buildingGraph", label = "Building Multiselect",
- choices = byCat_single,
- selected = input$building)
+ if (input$byActivity == FALSE) {
+ updatePickerInput(session, inputId = "building", choices = byCat_single)
} 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)
+ updatePickerInput(session, inputId = "building", choices = byAct_single)
}
})
- 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({
+ output$week_view <- renderUI({
- # Observe whether "Update Graphs" button is clicked
+ weekday_now <- weekdays(Sys.Date())
+
+ # Store building selected into a reactive value
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
- }
+ 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
})
- date_select <- date_app$date
- time_select <- time_app$time
- building_select <- building_selected$building
-
+ 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")
+ }
- #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)
+ # 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)
+ }
- #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')
+ # Function to create icon on leaflet map
+ getIcon <- function(dat){
+ icons <- awesomeIcons(
+ icon = 'ios-close',
+ iconColor = 'black',
+ library = 'ion',
+ markerColor = getColor(dat))
+ }
- 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
+ # 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%"))
+ }
- 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
+ # 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"}
+ }
- #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')
+ all_time <- unique(sun_dat$Hour)
- 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
+ # 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)
+ }
- 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
+ # 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")
+ }
- output$BuildingInfo <- renderText({
- if(building_select %in% buildinghoursAccessInfo$Building ){
- #paste("You have selected" , building_select)
- {stringr::str_c(building_select, "hours: ",buildinghoursAccessInfo[buildinghoursAccessInfo$Building == building_select, ]$TimeZone,
- ', Access:',
- buildinghoursAccessInfo[buildinghoursAccessInfo$Building == building_select, ]$Mode, sep = " ")}
- }
- else{
- paste("Building hours and access information for", building_select, "are not available at this time")
- }
- #paste("You have selected" , building_select)
+ # 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
})
- #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 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((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
-
+ # 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")
+ })
- #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 )
+ # 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)})
}
-
- }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!'}
+ # 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
})
-
-
- #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)
-
-
- })
-
-
-
- #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
+ 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)
})
- 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
-
+ 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")
+ })
- 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)
+ 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)})
}
- }
-
- #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)
+ # 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
+ })
- # 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")
+ 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)
+ })
- })
-
-
- #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({
+ 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 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
+ 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)})
}
})
- 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)
+ # 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
})
- #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
- )
- }
+ 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)
+ })
- icons <- awesomeIcons(
- icon = 'ios-close',
- iconColor = 'black',
- library = 'ion',
- markerColor = getColor(map_merge_filtered2)
- )
+ 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")
+ })
- #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')
+ 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)})
}
})
- #creating table
- #Add percentage column
- map_merge_filteredT$percentage <- percent(map_merge_filteredT$totalusers/map_merge_filteredT$capacity)
+ # Thursday Tab
+ thu_react_click <- reactiveValues(Clicks=NULL)
- # 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
- }
+ observeEvent(input$thu_click, {
+ click <- as.numeric(input$thu_click$x) - as.numeric(input$thu_click$domain$left)
+ thu_react_click$Clicks <- click
+ })
- # 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)' ))
+ 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)
+ })
- 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 (
- '
' + cellInfo.value + '
' +
- '
' + BuildingType + '
'
- )}"),html = TRUE),
-
- lat = colDef(show = FALSE),
- lng = colDef(show = FALSE),
- BuildingType = colDef(show = FALSE),
- totalusers = colDef(name = "Total Number of Users", align = 'left', style = 'text-align: right;'),
- capacity = colDef(show = FALSE),
- percentage = colDef(name = "Percentage of Max", format = colFormat(percent = TRUE), align = 'right', style = 'text-align: right;')
- ),
-
- columnGroups = list(
- colGroup(name = '', columns = c("Building", "BuildingType", "totalusers", "capacity", "percentage"),
- headerStyle = 'color: white; background-color: black;'))
-
-
- )
-
-
+ 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")
})
- # When the action link(building's name) is clicked, jump to "Find a Place to Study"
- observeEvent(input$jump_to_find_table, {
-
- # The index of row that is clicked by the user
- selectedRow <- as.numeric(strsplit(input$jump_to_find_table, "_")[[1]][2])
-
- # To make sure that if user go back to map after jumping to "Find a Place to Study", system will not jump back to "Find a Place to Study"
- if(map_merge_filteredT_2[selectedRow,]$Building != building_selected$building){
- # Switch to "Find a Place to Study"
- newtab <- switch(input$tabs, "map" = "find","find" = "map")
- updateTabItems(session, "tabs", newtab)
-
- # Update building selected of "Find a Place to Study"
- updateSelectInput(session, "building",
- choices = byCat_single,
- selected = map_merge_filteredT_2[selectedRow,]$Building)
- building_selected$building <- map_merge_filteredT_2[selectedRow,]$Building
+ 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)})
}
})
- #displaying the resulting map
+ # 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
+ })
- map <- leaflet(map_merge_filtered2) %>%
- addAwesomeMarkers(icon=icons,popup = ~paste0("Building: ", map_merge_filtered2$Building, " ", "Total number of Users: ", map_merge_filtered2$totalusers, " ",
- "Percentage of Capacity: ", percent(map_merge_filtered2$totalusers/map_merge_filtered2$capacity)," ", "Learn more about ", "", map_merge_filtered2$Building, "",
- " click ", actionLink(inputId = "jump_to_find", label = "here", onclick = 'Shiny.setInputValue(\"link1\", this.id, {priority: \"event\"})'))) %>%
- addTiles() %>%setView( lng = -73.6789, lat = 42.7298, zoom = 16 ) %>%
- #%>% addControl(map_title, position = "topright", className="map-title") %>%
- addLegend(position = "topleft", colors = c("#00BFFF", "orange", "#FF6347", "red"), labels = c("0% ~ 25%", "25% ~ 50%", "50% ~ 75%", "75% ~ 100%"))
+ 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)
+ })
- # If user selects a building, then add star icon at that building's position and star legend
- if (input$map_building != 'None') {
-
- # Using different color of star as icon and legend according to percentage of capacity
- if (building_map_select$totalusers <= 0.25*building_map_select$capacity){
- icon_url <- "images/blue_star.png"
- html_legend <- " Place of Selection "
- }
- else if (building_map_select$totalusers <= 0.5*building_map_select$capacity){
- icon_url <- "images/beige_star.png"
- html_legend <- " Place of Selection "
- }
- else if (building_map_select$totalusers <= 0.75*building_map_select$capacity){
- icon_url <- "images/lightred_star.png"
- html_legend <- " Place of Selection "
- }
- else {
- icon_url <- "images/darkred_star.png"
- html_legend <- " Place of Selection "
+ 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)})
}
-
- # Make star icon
- star_icon <- makeIcon(
- iconUrl = icon_url,
- iconWidth = 40, iconHeight= 40, iconAnchorX= 33*215/230/2, iconAnchorY = 16
- )
-
- # Add icon and legend
- map <- map %>% addMarkers(icon=star_icon,lng = building_map_select$lng, lat = building_map_select$lat,popup = ~paste0("Building: ", building_map_select$Building, " ", "Total number of Users: ", building_map_select$totalusers, " ",
- "Percentage of Capacity: ", percent(building_map_select$totalusers/building_map_select$capacity)," ", "Learn more about ", "", building_map_select$Building, "",
- " click ", actionLink(inputId = "jump_to_find", label = "here", onclick = 'Shiny.setInputValue(\"link1\", this.id, {priority: \"event\"})'))) %>%
- addControl(html = html_legend, position = "topleft")
- }
+ })
- output$mymap <- renderLeaflet({map})
+ # 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")
+ })
- # If the action link is not clicked, return nothing
- if (is.null(input$link1))
- return()
- # Isolate everything so that they just excute when user clicks the link
- isolate({
-
- # To determine name of building that is clicked
- marker_info <- input$mymap_marker_click
-
- # marker_info just has latitude and longitude so we need to pair them with our data to find the name of building
- marker_building <- map_merge_filtered[map_merge_filtered$lat == marker_info$lat,]
- marker_building <- marker_building[marker_building$lng == marker_info$lng,]
-
- # To make sure that if user go back to map after jumping to "Find a Place to Study", system will not jump back to "Find a Place to Study"
- if(building_map$building != marker_building$Building)
- {
- jump_find <- 'yes'
- building_map$building <- marker_building$Building
+ 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)})
}
})
-
- # If jump$find = yes, jump to "Find a Place to Study" and update everything
- if (jump_find == 'yes') {
- # Switch to "Find a Place to Study"
- newtab <- switch(input$tabs, "map" = "find","find" = "map")
- updateTabItems(session, "tabs", newtab)
-
- # Update building selected of "Find a Place to Study"
- updateSelectInput(session, "building",
- choices = byCat_single,
- selected = marker_building$Building)
- building_selected$building <- marker_building$Building
-
- jump_find <- 'no'
- }
-
})
##INITIAL POP-UP WARNING
@@ -1115,10 +775,6 @@ server <- function(input, output, session) {
observeEvent(input$run, {
removeModal()
})
-
-
-
-
}
# Run the application
diff --git a/app.R.bak b/app.R.bak
new file mode 100644
index 00000000..950bfaca
--- /dev/null
+++ b/app.R.bak
@@ -0,0 +1,1125 @@
+# Data Incite RPI Study Safe App using UI Template
+# Uses Shinydashboard as a framework https://rstudio.github.io/shinydashboard/
+# UI Template Created by Arielle Cerini, Brian Hotopp, Haoyu He, and James Young
+# Edited by Kara Kniss
+# Version: 26 Jan 2021
+
+#document for reading in the relevant libraries, data, and cleaning
+source('read_wapData.R')
+
+
+
+
+#LINK TO FEEDBACK SURVEY
+survey_url <- tags$a("survey", href = "https://docs.google.com/forms/d/e/1FAIpQLScvNquZHFMPXmzvj2_FGpzjpC7eMmfMEeO4sM_aSqZNhYCBFg/viewform?usp=sf_link", style = 'color: #990000; background-color: #FAFAFA')
+
+#LINK TO USABILITY STUDY
+usability_study_url <- tags$a("usability study", href = "https://forms.gle/tpMfaMv5dBfXSJUH6", style = 'color: #990000; background-color: #FAFAFA')
+
+
+
+ui <- dashboardPage(skin = "black", title = "RPI StudySafe",
+
+ #HEADER
+ dashboardHeader(title = tags$div(
+ class = "title-text",
+ tags$style(".logo {max-width: 80%;}"),
+ tags$div(id = "logo_block", tags$img(class="logo", src="Rensselaer.png", id="Rensselear Polytechnic Institute Logo") )),
+ titleWidth = "340px"
+ )
+
+
+
+ ,
+
+ #TOGGLED SIDEBAR
+ dashboardSidebar(
+ width = 320,
+ sidebarMenu(id = "tabs", collapsed = TRUE,
+ menuItem("Campus Map", tabName = "map", selected = TRUE),
+ menuItem("Find a Place To Study", tabName = "find"),
+ menuItem('Quick Compare', tabName='overview'),
+ menuItem("About", tabName = "about"),
+ tags$div(HTML(" ")),
+ box(width= 12, collapsible = TRUE, title = tags$div(HTML("Feedback Forms")),
+ style = 'color: #54585a;', solidHeader=TRUE,
+ tagList("Have any comments? Please follow the link to",
+ tags$br(),
+ "this", survey_url, "and let us know if you have any",
+ tags$br(),
+ " issues, questions, or suggestions regarding",
+ tags$br(),
+ " the StudySafe app."),
+ tags$br(), tags$br(),
+ tagList("Help us make the app better! Take a few",
+ tags$br(),
+ "minutes to participate in our ",usability_study_url, ".")
+ ),
+ uiOutput("side_ctrl")
+ )
+ ),
+
+ #BODY WITH REACTIVE TABS
+ dashboardBody(
+ style = "background-color: #f7f7f7; height: 100%; min-height: 100vh;",
+ shinyjs::useShinyjs(),
+ tabItems(
+
+ #ABOUT TAB
+ tabItem(tabName = "about",
+ uiOutput("about_body"),
+ tags$div(HTML(" ")),
+ tags$div(
+ HTML("
About RPIStudySafe
+
+
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.
+
+
+
Map
+
+
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:
+
+
+
Display Type: map or table
+
Date: Selecting which day to observe out of the past thirty days
+
Time: Selecting which time to observe on the selected date
+
Building: Selecting one building to stand out
+
+
+
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.
+
+
+
Find a Place to Study
+
+
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:
+
+
+
Date: Selecting which day to observe out of the past thirty days
+
Time: Selecting which time to observe on the selected date
+
Building: Selecting one building to observe
+
+
+
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.
+
+
+
Quick Compare
+
+
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:
+
+
+
Date: Selecting which day to observe out of the past thirty days
+
Time: Selecting which time to observe on the selected date
+
Buildings: Selecting multiple buildings to observe and compare
+
+
+
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.
+
+
DISCLAIMERS
+
+
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.
+
+
+ ")
+ ),
+ hr(),
+ HTML("")
+
+
+
+ ),
+
+ #FIND A PLACE TO STUDY TAB
+ tabItem(tabName="find",
+ uiOutput("find_body"),
+ tags$div(HTML(" ")),
+ #wellPanel(
+ tags$div(HTML("
Find a Place to Study
")),
+ fluidRow(column(12, box(collapsible = TRUE, width = '100%', title= tags$div(HTML("How to Use: Find a Place to Study")),
+ style = 'color:#54585a; background-color: white', solidHeader=TRUE,
+ HTML("
+
Open and close the dashboard menu by clicking the hamburger icon
+
Select a building by using the drop-down selection or typing to search.
+
Then click “NOW!” or select a date and time to see the building’s user activity throughout the day
+
If you wish to see a different building or hour, change your selections and click “Update Graphs”
+
Note: Any number of users less than 10 is rounded to either 0 or 10
\');
+ // $(".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
+
+ output$BuildingInfo <- renderText({
+ if(building_select %in% buildinghoursAccessInfo$Building ){
+ #paste("You have selected" , building_select)
+ {stringr::str_c(building_select, "hours: ",buildinghoursAccessInfo[buildinghoursAccessInfo$Building == building_select, ]$TimeZone,
+ ', Access:',
+ buildinghoursAccessInfo[buildinghoursAccessInfo$Building == building_select, ]$Mode, sep = " ")}
+ }
+ else{
+ paste("Building hours and access information for", building_select, "are not available at this time")
+ }
+ #paste("You have selected" , building_select)
+ })
+
+ #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)
+
+
+ })
+
+
+
+ #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 (
+ '
' + cellInfo.value + '
' +
+ '
' + BuildingType + '
'
+ )}"),html = TRUE),
+
+ lat = colDef(show = FALSE),
+ lng = colDef(show = FALSE),
+ BuildingType = colDef(show = FALSE),
+ totalusers = colDef(name = "Total Number of Users", align = 'left', style = 'text-align: right;'),
+ capacity = colDef(show = FALSE),
+ percentage = colDef(name = "Percentage of Max", format = colFormat(percent = TRUE), align = 'right', style = 'text-align: right;')
+ ),
+
+ columnGroups = list(
+ colGroup(name = '', columns = c("Building", "BuildingType", "totalusers", "capacity", "percentage"),
+ headerStyle = 'color: white; background-color: black;'))
+
+
+ )
+
+
+ })
+
+ # When the action link(building's name) is clicked, jump to "Find a Place to Study"
+ observeEvent(input$jump_to_find_table, {
+
+ # The index of row that is clicked by the user
+ selectedRow <- as.numeric(strsplit(input$jump_to_find_table, "_")[[1]][2])
+
+ # To make sure that if user go back to map after jumping to "Find a Place to Study", system will not jump back to "Find a Place to Study"
+ if(map_merge_filteredT_2[selectedRow,]$Building != building_selected$building){
+ # Switch to "Find a Place to Study"
+ newtab <- switch(input$tabs, "map" = "find","find" = "map")
+ updateTabItems(session, "tabs", newtab)
+
+ # Update building selected of "Find a Place to Study"
+ updateSelectInput(session, "building",
+ choices = byCat_single,
+ selected = map_merge_filteredT_2[selectedRow,]$Building)
+ building_selected$building <- map_merge_filteredT_2[selectedRow,]$Building
+ }
+ })
+
+ #displaying the resulting map
+
+ map <- leaflet(map_merge_filtered2) %>%
+ addAwesomeMarkers(icon=icons,popup = ~paste0("Building: ", map_merge_filtered2$Building, " ", "Total number of Users: ", map_merge_filtered2$totalusers, " ",
+ "Percentage of Capacity: ", percent(map_merge_filtered2$totalusers/map_merge_filtered2$capacity)," ", "Learn more about ", "", map_merge_filtered2$Building, "",
+ " click ", actionLink(inputId = "jump_to_find", label = "here", onclick = 'Shiny.setInputValue(\"link1\", this.id, {priority: \"event\"})'))) %>%
+ addTiles() %>%setView( lng = -73.6789, lat = 42.7298, zoom = 16 ) %>%
+ #%>% addControl(map_title, position = "topright", className="map-title") %>%
+ addLegend(position = "topleft", colors = c("#00BFFF", "orange", "#FF6347", "red"), labels = c("0% ~ 25%", "25% ~ 50%", "50% ~ 75%", "75% ~ 100%"))
+
+ # If user selects a building, then add star icon at that building's position and star legend
+ if (input$map_building != 'None') {
+
+ # Using different color of star as icon and legend according to percentage of capacity
+ if (building_map_select$totalusers <= 0.25*building_map_select$capacity){
+ icon_url <- "images/blue_star.png"
+ html_legend <- " Place of Selection "
+ }
+ else if (building_map_select$totalusers <= 0.5*building_map_select$capacity){
+ icon_url <- "images/beige_star.png"
+ html_legend <- " Place of Selection "
+ }
+ else if (building_map_select$totalusers <= 0.75*building_map_select$capacity){
+ icon_url <- "images/lightred_star.png"
+ html_legend <- " Place of Selection "
+ }
+ else {
+ icon_url <- "images/darkred_star.png"
+ html_legend <- " Place of Selection "
+ }
+
+ # Make star icon
+ star_icon <- makeIcon(
+ iconUrl = icon_url,
+ iconWidth = 40, iconHeight= 40, iconAnchorX= 33*215/230/2, iconAnchorY = 16
+ )
+
+ # Add icon and legend
+ map <- map %>% addMarkers(icon=star_icon,lng = building_map_select$lng, lat = building_map_select$lat,popup = ~paste0("Building: ", building_map_select$Building, " ", "Total number of Users: ", building_map_select$totalusers, " ",
+ "Percentage of Capacity: ", percent(building_map_select$totalusers/building_map_select$capacity)," ", "Learn more about ", "", building_map_select$Building, "",
+ " click ", actionLink(inputId = "jump_to_find", label = "here", onclick = 'Shiny.setInputValue(\"link1\", this.id, {priority: \"event\"})'))) %>%
+ addControl(html = html_legend, position = "topleft")
+ }
+
+ output$mymap <- renderLeaflet({map})
+
+
+
+ # If the action link is not clicked, return nothing
+ if (is.null(input$link1))
+ return()
+ # Isolate everything so that they just excute when user clicks the link
+ isolate({
+
+ # To determine name of building that is clicked
+ marker_info <- input$mymap_marker_click
+
+ # marker_info just has latitude and longitude so we need to pair them with our data to find the name of building
+ marker_building <- map_merge_filtered[map_merge_filtered$lat == marker_info$lat,]
+ marker_building <- marker_building[marker_building$lng == marker_info$lng,]
+
+ # To make sure that if user go back to map after jumping to "Find a Place to Study", system will not jump back to "Find a Place to Study"
+ if(building_map$building != marker_building$Building)
+ {
+ jump_find <- 'yes'
+ building_map$building <- marker_building$Building
+ }
+ })
+
+ # If jump$find = yes, jump to "Find a Place to Study" and update everything
+ if (jump_find == 'yes') {
+ # Switch to "Find a Place to Study"
+ newtab <- switch(input$tabs, "map" = "find","find" = "map")
+ updateTabItems(session, "tabs", newtab)
+
+ # Update building selected of "Find a Place to Study"
+ updateSelectInput(session, "building",
+ choices = byCat_single,
+ selected = marker_building$Building)
+ building_selected$building <- marker_building$Building
+
+ jump_find <- 'no'
+ }
+
+ })
+
+ ##INITIAL POP-UP WARNING
+ # Content of modal dialog
+ query_modal <- modalDialog(
+ title = tags$div(HTML("
Welcome to RPI StudySafe
")),
+ 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
Place of Selection 
Place of Selection 
Place of Selection 
Place of Selection