Permalink
Cannot retrieve contributors at this time
Name already in use
A tag already exists with the provided branch name. Many Git commands accept both tag and branch names, so creating this branch may cause unexpected behavior. Are you sure you want to create this branch?
IDEA-COVID-StudySafe/CopyOfnewApp.R
Go to fileThis commit does not belong to any branch on this repository, and may belong to a fork outside of the repository.
781 lines (713 sloc)
50.9 KB
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
| # 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("Activity Overview", tabName = "week_activity"), | |
| menuItem("About", tabName = "about"), | |
| tags$div(HTML("<br></br>")), | |
| box(width= 12, collapsible = TRUE, title = tags$div(HTML("<span style = 'color: #54585a '>Feedback Forms</span>")), | |
| 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("<br></br>")), | |
| tags$div( | |
| HTML("<h1 style = 'text-align: left'>About <span style = 'color:#54585a'>RPI</span> <b><span style = 'color: #990000;'>StudySafe</span></b></h1> | |
| <div style='margin-left: 5%'> | |
| <p>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 <a href = 'https://rpi.edu'; style = 'color: #990000; background-color: #f7f7f7'>Rensselaer Polytechnic Institute</a>, | |
| Troy, New York. Analysis and visualizations are by students and staff of | |
| <a href = 'https://idea.rpi.edu'; style = 'color: #990000; background-color: #f7f7f7'>The Rensselaer Institute for Data Exploration and Applications (IDEA)</a>. | |
| This is an app associated with the COVID-19 contact tracing and campus network mapping projects.</p> | |
| <p>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.</p> | |
| </div> | |
| <hr> | |
| <h4 style = 'text-align: left'>Map </h4> | |
| <div style='margin-left: 1%'> | |
| <p>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:</p> | |
| <span style = 'padding-bottom: 6.9px; font-size: 1.2em;line-height: 1.6em;font-weight: 400;color: #6e6e6e;'> | |
| <ui> | |
| <li>Display Type: map or table</li> | |
| <li>Date: Selecting which day to observe out of the past thirty days</li> | |
| <li>Time: Selecting which time to observe on the selected date</li> | |
| <li>Building: Selecting one building to stand out</li> | |
| </ui> | |
| </span> | |
| <p>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.</p> | |
| </div> | |
| <h4 style = 'text-align: left'>Find a Place to Study </h4> | |
| <div style='margin-left: 1%'> | |
| <p>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:</p> | |
| <span style = 'padding-bottom: 6.9px; font-size: 1.2em;line-height: 1.6em;font-weight: 400;color: #6e6e6e;'> | |
| <ui> | |
| <li>Date: Selecting which day to observe out of the past thirty days</li> | |
| <li>Time: Selecting which time to observe on the selected date</li> | |
| <li>Building: Selecting one building to observe</li> | |
| </ui> | |
| </span> | |
| <p>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.</p> | |
| </div> | |
| <h4 style = 'text-align: left'>Quick Compare </h4> | |
| <div style='margin-left: 1%'> | |
| <p>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:</p> | |
| <span style = 'padding-bottom: 6.9px; font-size: 1.2em;line-height: 1.6em;font-weight: 400;color: #6e6e6e;'> | |
| <ui> | |
| <li>Date: Selecting which day to observe out of the past thirty days</li> | |
| <li>Time: Selecting which time to observe on the selected date</li> | |
| <li>Buildings: Selecting multiple buildings to observe and compare</li> | |
| </ui> | |
| </span> | |
| <p>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.</p> | |
| </div> | |
| <h4 style = 'text-align: left'>DISCLAIMERS</h4> | |
| <div style='margin-left: 1%'> | |
| <p>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. </p> | |
| </div> | |
| ") | |
| ), | |
| hr(), | |
| HTML("<footer text-align: center; '> | |
| <h1 style = 'color:#990000; font-size: 1.5em;'> | |
| <a href='https://idea.rpi.edu/'; style = 'color: #990000; background-color: #f7f7f7;'>About IDEA</a> | |
| | | |
| <a href='https://info.rpi.edu/web-privacy-statement'; style = 'color: #990000; background-color: #f7f7f7;'>Privacy Policy</a> | |
| | | |
| <a href='https://github.rpi.edu/DataINCITE/IDEA-COVID-StudySafe'; style = 'color: #990000; background-color: #f7f7f7;'>GitHub</a> | |
| </h1> | |
| </footer>") | |
| ), | |
| # "Google" Tab ################################################################################################################################################### | |
| tabItem(tabName = "week_activity", | |
| uiOutput("week_view"), | |
| tags$div(HTML("<br><br></br>")), | |
| 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("<b><span style = 'color: #54585a'>Choose a Building</span></b>")), | |
| options = list(`live-search` = TRUE), | |
| choices = byCat_single), | |
| prettySwitch(inputId = 'byActivity', inline = TRUE, | |
| label= tags$div(HTML("<b><span style = 'color: #54585a'>List by Activity</span></b>")), | |
| 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("<b><span style = 'color: #54585a'>Choose a Building</span></b>")), | |
| options = list(`live-search` = TRUE), | |
| choices = byCat_single), | |
| prettySwitch(inputId = 'byActivity', inline = TRUE, | |
| label= tags$div(HTML("<b><span style = 'color: #54585a'>List by Activity</span></b>")), | |
| 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("<b><span style = 'color: #54585a'>Choose a Building</span></b>")), | |
| options = list(`live-search` = TRUE), | |
| choices = byCat_single), | |
| prettySwitch(inputId = 'byActivity', inline = TRUE, | |
| label= tags$div(HTML("<b><span style = 'color: #54585a'>List by Activity</span></b>")), | |
| 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("<b><span style = 'color: #54585a'>Choose a Building</span></b>")), | |
| options = list(`live-search` = TRUE), | |
| choices = byCat_single), | |
| prettySwitch(inputId = 'byActivity', inline = TRUE, | |
| label= tags$div(HTML("<b><span style = 'color: #54585a'>List by Activity</span></b>")), | |
| 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("<b><span style = 'color: #54585a'>Choose a Building</span></b>")), | |
| options = list(`live-search` = TRUE), | |
| choices = byCat_single), | |
| prettySwitch(inputId = 'byActivity', inline = TRUE, | |
| label= tags$div(HTML("<b><span style = 'color: #54585a'>List by Activity</span></b>")), | |
| 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("<b><span style = 'color: #54585a'>Choose a Building</span></b>")), | |
| options = list(`live-search` = TRUE), | |
| choices = byCat_single), | |
| prettySwitch(inputId = 'byActivity', inline = TRUE, | |
| label= tags$div(HTML("<b><span style = 'color: #54585a'>List by Activity</span></b>")), | |
| 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("<b><span style = 'color: #54585a'>Choose a Building</span></b>")), | |
| options = list(`live-search` = TRUE), | |
| choices = byCat_single), | |
| prettySwitch(inputId = 'byActivity', inline = TRUE, | |
| label= tags$div(HTML("<b><span style = 'color: #54585a'>List by Activity</span></b>")), | |
| 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 | |
| tags$script(HTML(' | |
| $(document).ready(function() { | |
| $(\'head\').append(\'<link rel="stylesheet" href="" type="text/css" />\'); | |
| $(\'head\').append(\'<link rel="stylesheet" href="brand_style.css" type="text/css" />\'); | |
| $("header").find("nav").append(\'<p style="font-size: 200%; text-align: center;">RPI<b><span style = "color: #990000;"><span style="padding-left:2px; padding-right: 2px;">StudySafe</span></span></b></p>\'); | |
| // $(".sidebar-toggle").insertAfter(".tab-content"); | |
| }) | |
| ')), | |
| ) | |
| ) | |
| # Define server logic required | |
| server <- function(input, output, session) { | |
| #ABOUT TAB | |
| output$about_body <- renderUI({}) | |
| # "Google" Tab ################################################################################################################################################### | |
| # Set default tab to today's weekday | |
| observe({ | |
| weekday_now <- weekdays(Sys.Date()) | |
| updateTabsetPanel(session,"week_tab", selected = weekday_now) | |
| }) | |
| #Activity Tagging Switch consistent across all tabs - NOT WORKING YET, WILL IMPLEMENT LATER | |
| observe({ | |
| if (input$byActivity == FALSE) { | |
| updatePickerInput(session, inputId = "building", choices = byCat_single) | |
| } else { | |
| updatePickerInput(session, inputId = "building", choices = byAct_single) | |
| } | |
| }) | |
| output$week_view <- renderUI({ | |
| weekday_now <- weekdays(Sys.Date()) | |
| # Store building selected into a reactive value | |
| observe({ | |
| sun_building_selected$building <- input$sun_selected | |
| mon_building_selected$building <- input$mon_selected | |
| tue_building_selected$building <- input$tue_selected | |
| wed_building_selected$building <- input$wed_selected | |
| thu_building_selected$building <- input$thu_selected | |
| fri_building_selected$building <- input$fri_selected | |
| sat_building_selected$building <- input$sat_selected | |
| }) | |
| sun_select <- sun_building_selected$building | |
| mon_select <- mon_building_selected$building | |
| tue_select <- tue_building_selected$building | |
| wed_select <- wed_building_selected$building | |
| thu_select <- thu_building_selected$building | |
| fri_select <- fri_building_selected$building | |
| sat_select <- sat_building_selected$building | |
| sun_dat <- rpi_wap_last7 %>% filter(weekday == "Sunday") | |
| mon_dat <- rpi_wap_last7 %>% filter(weekday == "Monday") | |
| tue_dat <- rpi_wap_last7 %>% filter(weekday == "Tuesday") | |
| wed_dat <- rpi_wap_last7 %>% filter(weekday == "Wednesday") | |
| thu_dat <- rpi_wap_last7 %>% filter(weekday == "Thursday") | |
| fri_dat <- rpi_wap_last7 %>% filter(weekday == "Friday") | |
| sat_dat <- rpi_wap_last7 %>% filter(weekday == "Saturday") | |
| # Function to get map information for leaflet map | |
| get_map_info <- function(dat, hour, hits_per_wap_semester_by_building_max) { | |
| map_info <- dat %>% filter(Hour==hour) %>% | |
| select(lat, lng, BuildingType,Building, users) %>% | |
| group_by(lat, lng, BuildingType,Building) %>% | |
| dplyr::summarise(totalusers = sum(users)) | |
| map_info <- merge(map_info, hits_per_wap_semester_by_building_max, by.x= "Building", by.y="Building") | |
| } | |
| # Function to get marker color on leaflet map | |
| getColor <- function(dat) { | |
| mapply(function(totalusers, capacity) { | |
| if(totalusers <= 0.25*capacity) {"darkblue"} | |
| else if(totalusers <= 0.5*capacity) {"lightblue"} | |
| else if(totalusers <= 0.75*capacity) {"lightred"} | |
| else {"red"}}, | |
| dat$totalusers, dat$capacity) | |
| } | |
| # Function to create icon on leaflet map | |
| getIcon <- function(dat){ | |
| icons <- awesomeIcons( | |
| icon = 'ios-close', | |
| iconColor = 'black', | |
| library = 'ion', | |
| markerColor = getColor(dat)) | |
| } | |
| # Function to generate leaflet map | |
| get_map <- function(dat) { | |
| leaf_map <- leaflet(dat) %>% | |
| addAwesomeMarkers(icon=getIcon(dat)) %>% | |
| addTiles() %>%setView( lng = -73.6789, lat = 42.7298, zoom = 16 ) %>% | |
| addLegend(position = "topleft", colors = c("#235878", "#65b7de", "#f28e80", "#c44130"), labels = c("0% ~ 25%", "25% ~ 50%", "50% ~ 75%", "75% ~ 100%")) | |
| } | |
| # Function to generate comments on how busy the building is | |
| busy_text <- function(dat, building_select, hits_per_wap_semester_by_building_max){ | |
| building_select_cap <- subset(hits_per_wap_semester_by_building_max, hits_per_wap_semester_by_building_max$Building == building_select) | |
| cap <- dat$users / building_select_cap$capacity | |
| if(cap <= .25){busy_summary <- "usually not busy"} | |
| else if(cap <= .5 & cap > .25){busy_summary <- "usually not too busy"} | |
| else if(cap <= .75 & cap > .5){busy_summary <- "usually a bit busy"} | |
| else {busy_summary <- "usually as busy as it can get"} | |
| } | |
| all_time <- unique(sun_dat$Hour) | |
| # Function to generate capacity line on bar plot | |
| capacity_intercept <- function(capacity){ | |
| c1 <- capacity * .25 | |
| c2 <- capacity * .5 | |
| c3 <- capacity * .75 | |
| cut <- c(c1, c2, c3, capacity) | |
| } | |
| # Function to make bar plot | |
| make_plot <- function(dat, time_now, building_select, hits_per_wap_semester_by_building_max){ | |
| building_select_cap <- subset(hits_per_wap_semester_by_building_max, hits_per_wap_semester_by_building_max$Building == building_select) | |
| cap_line <- capacity_intercept(building_select_cap$capacity) | |
| ggplot(dat, aes(x=factor(Hour), y=users, fill=(Hour==time_now))) + | |
| geom_bar(stat="identity") + | |
| scale_fill_manual(values=c("skyblue3","mediumvioletred")) + | |
| geom_vline(xintercept = as.integer(time_now)+1, linetype = "dotted") + | |
| geom_hline(yintercept = cap_line, linetype = "dotted") + | |
| scale_x_discrete(labels= all_time) + | |
| scale_y_continuous(breaks = cap_line, labels = c("25%", "50%", "75%", "100%")) + | |
| ylab("Building Capacity") + | |
| theme(panel.grid.major = element_blank(), | |
| panel.grid.minor = element_blank(), | |
| panel.background = element_blank(), | |
| plot.background = element_blank(), | |
| axis.ticks.y = element_blank(), | |
| axis.ticks.x = element_blank(), | |
| axis.title.x=element_blank(), | |
| legend.position="none") | |
| } | |
| # Sunday Tab | |
| sun_react_click <- reactiveValues(Clicks=NULL) | |
| observeEvent(input$sun_click, { | |
| click <- as.numeric(input$sun_click$x) - as.numeric(input$sun_click$domain$left) | |
| sun_react_click$Clicks <- click | |
| }) | |
| # If click a marker on leaflet map, update the marker color to green and the building selection on the side panel | |
| observeEvent(input$sunMap_marker_click,{ | |
| req(input$sunMap_marker_click) | |
| clicks <- data.frame(input$sunMap_marker_click[3:4]) | |
| icon <- awesomeIcons(icon = 'ios-close', iconColor="black", library='ion', markerColor="green") | |
| leafletProxy("sunMap") %>% clearGroup(group="selected") %>% addAwesomeMarkers(icon= icon, data = clicks, group="selected") | |
| building_select <- sun_dat %>% filter(lng==clicks[,2], lat==clicks[,1]) %>% select(Building) | |
| building_select <- unique(building_select) | |
| updatePickerInput(session, inputId="sun_selected", selected=building_select) | |
| }) | |
| # If change the building selection on the side panel, update the marker on the map to green | |
| observeEvent(input$sun_selected,{ | |
| clicks <- sun_dat %>% filter(Building==sun_select) %>% select(lat,lng) | |
| clicks <- clicks[1,1:2] | |
| icon <- awesomeIcons(icon = 'ios-close', iconColor="black", library='ion', markerColor="green") | |
| leafletProxy("sunMap") %>% clearGroup(group="selected") %>% addAwesomeMarkers(icon= icon, data = clicks, group="selected") | |
| }) | |
| # Create the leaflet map and bar plot | |
| observe({ | |
| time_now <- as.integer(format(Sys.time(), "%H")) | |
| sun_select_dat <- sun_dat %>% filter(Building == sun_select) | |
| # If nothing is clicked, the bar plot by default will use the current time | |
| if (is.null(sun_react_click$Clicks)){ | |
| sun_hr_dat <- sun_select_dat[time_now+1,] | |
| hr_pick_plot <- make_plot(sun_select_dat, time_now, sun_select, hits_per_wap_semester_by_building_max) | |
| output_text <- busy_text(sun_hr_dat, sun_hr_dat$Building, hits_per_wap_semester_by_building_max) | |
| sun_map_info <- get_map_info(sun_dat, time_now, hits_per_wap_semester_by_building_max) | |
| leaf_map <- get_map(sun_map_info) | |
| output$sunMap <- renderLeaflet({leaf_map}) | |
| output$sun_plot <- renderPlot({hr_pick_plot}, bg="transparent") | |
| output$sun_info <- renderUI({p("At", as.numeric(sun_hr_dat$Hour), ":00,",sun_select, "is", output_text)}) | |
| } else { | |
| sun_hr_dat <- sun_select_dat[floor(sun_react_click$Clicks)+1,] | |
| output_text <- busy_text(sun_hr_dat, sun_hr_dat$Building, hits_per_wap_semester_by_building_max) | |
| # time_now <- as.integer(sun_react_click$Clicks) | |
| time_now <- sun_hr_dat$Hour | |
| sun_map_info <- get_map_info(sun_dat, time_now, hits_per_wap_semester_by_building_max) | |
| leaf_map <- get_map(sun_map_info) | |
| output$sunMap <- renderLeaflet({leaf_map}) | |
| hr_pick_plot <- make_plot(sun_select_dat, time_now, sun_select, hits_per_wap_semester_by_building_max) | |
| output$sun_plot <- renderPlot({hr_pick_plot}, bg="transparent") | |
| output$sun_info <- renderUI({p("At", as.numeric(sun_hr_dat$Hour), ":00,", sun_select,"is", output_text)}) | |
| } | |
| }) | |
| # Monday Tab | |
| mon_react_click <- reactiveValues(Clicks=NULL) | |
| observeEvent(input$mon_click, { | |
| click <- as.numeric(input$mon_click$x) - as.numeric(input$mon_click$domain$left) | |
| mon_react_click$Clicks <- click | |
| }) | |
| observeEvent(input$monMap_marker_click,{ | |
| req(input$monMap_marker_click) | |
| clicks <- data.frame(input$monMap_marker_click[3:4]) | |
| icon <- awesomeIcons(icon = 'ios-close', iconColor="black", library='ion', markerColor="green") | |
| leafletProxy("monMap") %>% clearGroup(group="selected") %>% addAwesomeMarkers(icon= icon, data = clicks, group="selected") | |
| building_select <- mon_dat %>% filter(lng==clicks[,2], lat==clicks[,1]) %>% select(Building) | |
| building_select <- unique(building_select) | |
| updatePickerInput(session, inputId="mon_selected", selected=building_select) | |
| }) | |
| observeEvent(input$mon_selected,{ | |
| clicks <- mon_dat %>% filter(Building==mon_select) %>% select(lat,lng) | |
| clicks <- clicks[1,1:2] | |
| icon <- awesomeIcons(icon = 'ios-close', iconColor="black", library='ion', markerColor="green") | |
| leafletProxy("monMap") %>% clearGroup(group="selected") %>% addAwesomeMarkers(icon= icon, data = clicks, group="selected") | |
| }) | |
| observe({ | |
| time_now <- as.integer(format(Sys.time(), "%H")) | |
| mon_select_dat <- mon_dat %>% filter(Building == mon_select) | |
| if (is.null(mon_react_click$Clicks)){ | |
| mon_hr_dat <- mon_select_dat[time_now+1,] | |
| hr_pick_plot <- make_plot(mon_select_dat, time_now, mon_select, hits_per_wap_semester_by_building_max) | |
| output_text <- busy_text(mon_hr_dat, mon_hr_dat$Building, hits_per_wap_semester_by_building_max) | |
| mon_map_info <- get_map_info(mon_dat, time_now, hits_per_wap_semester_by_building_max) | |
| leaf_map <- get_map(mon_map_info) | |
| output$monMap <- renderLeaflet({leaf_map}) | |
| output$mon_plot <- renderPlot({hr_pick_plot}, bg="transparent") | |
| output$mon_info <- renderUI({p("At", as.numeric(mon_hr_dat$Hour), ":00,",mon_select, "is", output_text)}) | |
| } else { | |
| mon_hr_dat <- mon_select_dat[floor(mon_react_click$Clicks)+1,] | |
| output_text <- busy_text(mon_hr_dat, mon_hr_dat$Building, hits_per_wap_semester_by_building_max) | |
| # time_now <- as.integer(sat_react_click$Clicks) | |
| time_now <- mon_hr_dat$Hour | |
| mon_map_info <- get_map_info(mon_dat, time_now, hits_per_wap_semester_by_building_max) | |
| leaf_map <- get_map(mon_map_info) | |
| output$monMap <- renderLeaflet({leaf_map}) | |
| hr_pick_plot <- make_plot(mon_select_dat, time_now, mon_select, hits_per_wap_semester_by_building_max) | |
| output$mon_plot <- renderPlot({hr_pick_plot}, bg="transparent") | |
| output$mon_info <- renderUI({p("At", as.numeric(mon_hr_dat$Hour), ":00,", mon_select,"is", output_text)}) | |
| } | |
| }) | |
| # Tuesday Tab | |
| tue_react_click <- reactiveValues(Clicks=NULL) | |
| observeEvent(input$tue_click, { | |
| click <- as.numeric(input$tue_click$x) - as.numeric(input$tue_click$domain$left) | |
| tue_react_click$Clicks <- click | |
| }) | |
| observeEvent(input$tueMap_marker_click,{ | |
| req(input$tueMap_marker_click) | |
| clicks <- data.frame(input$tueMap_marker_click[3:4]) | |
| icon <- awesomeIcons(icon = 'ios-close', iconColor="black", library='ion', markerColor="green") | |
| leafletProxy("tueMap") %>% clearGroup(group="selected") %>% addAwesomeMarkers(icon= icon, data = clicks, group="selected") | |
| building_select <- tue_dat %>% filter(lng==clicks[,2], lat==clicks[,1]) %>% select(Building) | |
| building_select <- unique(building_select) | |
| updatePickerInput(session, inputId="tue_selected", selected=building_select) | |
| }) | |
| observeEvent(input$tue_selected,{ | |
| clicks <- tue_dat %>% filter(Building==tue_select) %>% select(lat,lng) | |
| clicks <- clicks[1,1:2] | |
| icon <- awesomeIcons(icon = 'ios-close', iconColor="black", library='ion', markerColor="green") | |
| leafletProxy("tueMap") %>% clearGroup(group="selected") %>% addAwesomeMarkers(icon= icon, data = clicks, group="selected") | |
| }) | |
| observe({ | |
| time_now <- as.integer(format(Sys.time(), "%H")) | |
| tue_select_dat <- tue_dat %>% filter(Building == tue_select) | |
| if (is.null(tue_react_click$Clicks)){ | |
| tue_hr_dat <- tue_select_dat[time_now+1,] | |
| hr_pick_plot <- make_plot(tue_select_dat, time_now, tue_select, hits_per_wap_semester_by_building_max) | |
| output_text <- busy_text(tue_hr_dat, tue_hr_dat$Building, hits_per_wap_semester_by_building_max) | |
| tue_map_info <- get_map_info(tue_dat, time_now, hits_per_wap_semester_by_building_max) | |
| leaf_map <- get_map(tue_map_info) | |
| output$tueMap <- renderLeaflet({leaf_map}) | |
| output$tue_plot <- renderPlot({hr_pick_plot}, bg="transparent") | |
| output$tue_info <- renderUI({p("At", as.numeric(tue_hr_dat$Hour), ":00,",tue_select, "is", output_text)}) | |
| } else { | |
| tue_hr_dat <- tue_select_dat[floor(tue_react_click$Clicks)+1,] | |
| output_text <- busy_text(tue_hr_dat, tue_hr_dat$Building, hits_per_wap_semester_by_building_max) | |
| # time_now <- as.integer(tue_react_click$Clicks) | |
| time_now <- tue_hr_dat$Hour | |
| tue_map_info <- get_map_info(tue_dat, time_now, hits_per_wap_semester_by_building_max) | |
| leaf_map <- get_map(tue_map_info) | |
| output$tueMap <- renderLeaflet({leaf_map}) | |
| hr_pick_plot <- make_plot(tue_select_dat, time_now, tue_select, hits_per_wap_semester_by_building_max) | |
| output$tue_plot <- renderPlot({hr_pick_plot}, bg="transparent") | |
| output$tue_info <- renderUI({p("At", as.numeric(tue_hr_dat$Hour), ":00,", tue_select,"is", output_text)}) | |
| } | |
| }) | |
| # Wednesday Tab | |
| wed_react_click <- reactiveValues(Clicks=NULL) | |
| observeEvent(input$wed_click, { | |
| click <- as.numeric(input$wed_click$x) - as.numeric(input$wed_click$domain$left) | |
| wed_react_click$Clicks <- click | |
| }) | |
| observeEvent(input$wedMap_marker_click,{ | |
| req(input$wedMap_marker_click) | |
| clicks <- data.frame(input$wedMap_marker_click[3:4]) | |
| icon <- awesomeIcons(icon = 'ios-close', iconColor="black", library='ion', markerColor="green") | |
| leafletProxy("wedMap") %>% clearGroup(group="selected") %>% addAwesomeMarkers(icon= icon, data = clicks, group="selected") | |
| building_select <- wed_dat %>% filter(lng==clicks[,2], lat==clicks[,1]) %>% select(Building) | |
| building_select <- unique(building_select) | |
| updatePickerInput(session, inputId="wed_selected", selected=building_select) | |
| }) | |
| observeEvent(input$wed_selected,{ | |
| clicks <- wed_dat %>% filter(Building==wed_select) %>% select(lat,lng) | |
| clicks <- clicks[1,1:2] | |
| icon <- awesomeIcons(icon = 'ios-close', iconColor="black", library='ion', markerColor="green") | |
| leafletProxy("wedMap") %>% clearGroup(group="selected") %>% addAwesomeMarkers(icon= icon, data = clicks, group="selected") | |
| }) | |
| observe({ | |
| time_now <- as.integer(format(Sys.time(), "%H")) | |
| wed_select_dat <- wed_dat %>% filter(Building == wed_select) | |
| if (is.null(wed_react_click$Clicks)){ | |
| wed_hr_dat <- wed_select_dat[time_now+1,] | |
| hr_pick_plot <- make_plot(wed_select_dat, time_now, wed_select, hits_per_wap_semester_by_building_max) | |
| output_text <- busy_text(wed_hr_dat, wed_hr_dat$Building, hits_per_wap_semester_by_building_max) | |
| wed_map_info <- get_map_info(wed_dat, time_now, hits_per_wap_semester_by_building_max) | |
| leaf_map <- get_map(wed_map_info) | |
| output$wedMap <- renderLeaflet({leaf_map}) | |
| output$wed_plot <- renderPlot({hr_pick_plot}, bg="transparent") | |
| output$wed_info <- renderUI({p("At", as.numeric(wed_hr_dat$Hour), ":00,",wed_select, "is", output_text)}) | |
| } else { | |
| wed_hr_dat <- wed_select_dat[floor(wed_react_click$Clicks)+1,] | |
| output_text <- busy_text(wed_hr_dat, wed_hr_dat$Building, hits_per_wap_semester_by_building_max) | |
| # time_now <- as.integer(wed_react_click$Clicks) | |
| time_now <- wed_hr_dat$Hour | |
| wed_map_info <- get_map_info(wed_dat, time_now, hits_per_wap_semester_by_building_max) | |
| leaf_map <- get_map(wed_map_info) | |
| output$wedMap <- renderLeaflet({leaf_map}) | |
| hr_pick_plot <- make_plot(wed_select_dat, time_now, wed_select, hits_per_wap_semester_by_building_max) | |
| output$wed_plot <- renderPlot({hr_pick_plot}, bg="transparent") | |
| output$wed_info <- renderUI({p("At", as.numeric(wed_hr_dat$Hour), ":00,", wed_select,"is", output_text)}) | |
| } | |
| }) | |
| # Thursday Tab | |
| thu_react_click <- reactiveValues(Clicks=NULL) | |
| observeEvent(input$thu_click, { | |
| click <- as.numeric(input$thu_click$x) - as.numeric(input$thu_click$domain$left) | |
| thu_react_click$Clicks <- click | |
| }) | |
| observeEvent(input$thuMap_marker_click,{ | |
| req(input$thuMap_marker_click) | |
| clicks <- data.frame(input$thuMap_marker_click[3:4]) | |
| icon <- awesomeIcons(icon = 'ios-close', iconColor="black", library='ion', markerColor="green") | |
| leafletProxy("thuMap") %>% clearGroup(group="selected") %>% addAwesomeMarkers(icon= icon, data = clicks, group="selected") | |
| building_select <- thu_dat %>% filter(lng==clicks[,2], lat==clicks[,1]) %>% select(Building) | |
| building_select <- unique(building_select) | |
| updatePickerInput(session, inputId="thu_selected", selected=building_select) | |
| }) | |
| observeEvent(input$thu_selected,{ | |
| clicks <- thu_dat %>% filter(Building==thu_select) %>% select(lat,lng) | |
| clicks <- clicks[1,1:2] | |
| icon <- awesomeIcons(icon = 'ios-close', iconColor="black", library='ion', markerColor="green") | |
| leafletProxy("thuMap") %>% clearGroup(group="selected") %>% addAwesomeMarkers(icon= icon, data = clicks, group="selected") | |
| }) | |
| observe({ | |
| time_now <- as.integer(format(Sys.time(), "%H")) | |
| thu_select_dat <- thu_dat %>% filter(Building == thu_select) | |
| if (is.null(thu_react_click$Clicks)){ | |
| thu_hr_dat <- thu_select_dat[time_now+1,] | |
| hr_pick_plot <- make_plot(thu_select_dat, time_now, thu_select, hits_per_wap_semester_by_building_max) | |
| output_text <- busy_text(thu_hr_dat, thu_hr_dat$Building, hits_per_wap_semester_by_building_max) | |
| thu_map_info <- get_map_info(thu_dat, time_now, hits_per_wap_semester_by_building_max) | |
| leaf_map <- get_map(thu_map_info) | |
| output$thuMap <- renderLeaflet({leaf_map}) | |
| output$thu_plot <- renderPlot({hr_pick_plot}, bg="transparent") | |
| output$thu_info <- renderUI({p("At", as.numeric(thu_hr_dat$Hour), ":00,",thu_select, "is", output_text)}) | |
| } else { | |
| thu_hr_dat <- thu_select_dat[floor(thu_react_click$Clicks)+1,] | |
| output_text <- busy_text(thu_hr_dat, thu_hr_dat$Building, hits_per_wap_semester_by_building_max) | |
| # time_now <- as.integer(thu_react_click$Clicks) | |
| time_now <- thu_hr_dat$Hour | |
| thu_map_info <- get_map_info(thu_dat, time_now, hits_per_wap_semester_by_building_max) | |
| leaf_map <- get_map(thu_map_info) | |
| output$thuMap <- renderLeaflet({leaf_map}) | |
| hr_pick_plot <- make_plot(thu_select_dat, time_now, thu_select, hits_per_wap_semester_by_building_max) | |
| output$thu_plot <- renderPlot({hr_pick_plot}, bg="transparent") | |
| output$thu_info <- renderUI({p("At", as.numeric(thu_hr_dat$Hour), ":00,", thu_select,"is", output_text)}) | |
| } | |
| }) | |
| # Friday Tab | |
| fri_react_click <- reactiveValues(Clicks=NULL) | |
| observeEvent(input$fri_click, { | |
| click <- as.numeric(input$fri_click$x) - as.numeric(input$fri_click$domain$left) | |
| fri_react_click$Clicks <- click | |
| }) | |
| observeEvent(input$friMap_marker_click,{ | |
| req(input$friMap_marker_click) | |
| clicks <- data.frame(input$friMap_marker_click[3:4]) | |
| icon <- awesomeIcons(icon = 'ios-close', iconColor="black", library='ion', markerColor="green") | |
| leafletProxy("friMap") %>% clearGroup(group="selected") %>% addAwesomeMarkers(icon= icon, data = clicks, group="selected") | |
| building_select <- fri_dat %>% filter(lng==clicks[,2], lat==clicks[,1]) %>% select(Building) | |
| building_select <- unique(building_select) | |
| updatePickerInput(session, inputId="fri_selected", selected=building_select) | |
| }) | |
| observeEvent(input$fri_selected,{ | |
| clicks <- fri_dat %>% filter(Building==fri_select) %>% select(lat,lng) | |
| clicks <- clicks[1,1:2] | |
| icon <- awesomeIcons(icon = 'ios-close', iconColor="black", library='ion', markerColor="green") | |
| leafletProxy("friMap") %>% clearGroup(group="selected") %>% addAwesomeMarkers(icon= icon, data = clicks, group="selected") | |
| }) | |
| observe({ | |
| time_now <- as.integer(format(Sys.time(), "%H")) | |
| fri_select_dat <- fri_dat %>% filter(Building == fri_select) | |
| if (is.null(fri_react_click$Clicks)){ | |
| fri_hr_dat <- fri_select_dat[time_now+1,] | |
| hr_pick_plot <- make_plot(fri_select_dat, time_now, fri_select, hits_per_wap_semester_by_building_max) | |
| output_text <- busy_text(fri_hr_dat, fri_hr_dat$Building, hits_per_wap_semester_by_building_max) | |
| fri_map_info <- get_map_info(fri_dat, time_now, hits_per_wap_semester_by_building_max) | |
| leaf_map <- get_map(fri_map_info) | |
| output$friMap <- renderLeaflet({leaf_map}) | |
| output$fri_plot <- renderPlot({hr_pick_plot}, bg="transparent") | |
| output$fri_info <- renderUI({p("At", as.numeric(fri_hr_dat$Hour), ":00,",fri_select, "is", output_text)}) | |
| } else { | |
| fri_hr_dat <- fri_select_dat[floor(fri_react_click$Clicks)+1,] | |
| output_text <- busy_text(fri_hr_dat, fri_hr_dat$Building, hits_per_wap_semester_by_building_max) | |
| # time_now <- as.integer(fri_react_click$Clicks) | |
| time_now <- fri_hr_dat$Hour | |
| fri_map_info <- get_map_info(fri_dat, time_now, hits_per_wap_semester_by_building_max) | |
| leaf_map <- get_map(fri_map_info) | |
| output$friMap <- renderLeaflet({leaf_map}) | |
| hr_pick_plot <- make_plot(fri_select_dat, time_now, fri_select, hits_per_wap_semester_by_building_max) | |
| output$fri_plot <- renderPlot({hr_pick_plot}, bg="transparent") | |
| output$fri_info <- renderUI({p("At", as.numeric(fri_hr_dat$Hour), ":00,", fri_select,"is", output_text)}) | |
| } | |
| }) | |
| # Saturday Tab | |
| sat_react_click <- reactiveValues(Clicks=NULL) | |
| observeEvent(input$sat_click, { | |
| click <- as.numeric(input$sat_click$x) - as.numeric(input$sat_click$domain$left) | |
| sat_react_click$Clicks <- click | |
| }) | |
| observeEvent(input$satMap_marker_click,{ | |
| req(input$satMap_marker_click) | |
| clicks <- data.frame(input$satMap_marker_click[3:4]) | |
| icon <- awesomeIcons(icon = 'ios-close', iconColor="black", library='ion', markerColor="green") | |
| leafletProxy("satMap") %>% clearGroup(group="selected") %>% addAwesomeMarkers(icon= icon, data = clicks, group="selected") | |
| building_select <- sat_dat %>% filter(lng==clicks[,2], lat==clicks[,1]) %>% select(Building) | |
| building_select <- unique(building_select) | |
| updatePickerInput(session, inputId="sat_selected", selected=building_select) | |
| }) | |
| observeEvent(input$sat_selected,{ | |
| clicks <- sat_dat %>% filter(Building==sat_select) %>% select(lat,lng) | |
| clicks <- clicks[1,1:2] | |
| icon <- awesomeIcons(icon = 'ios-close', iconColor="black", library='ion', markerColor="green") | |
| leafletProxy("satMap") %>% clearGroup(group="selected") %>% addAwesomeMarkers(icon= icon, data = clicks, group="selected") | |
| }) | |
| observe({ | |
| time_now <- as.integer(format(Sys.time(), "%H")) | |
| sat_select_dat <- sat_dat %>% filter(Building == sat_select) | |
| if (is.null(sat_react_click$Clicks)){ | |
| sat_hr_dat <- sat_select_dat[time_now+1,] | |
| hr_pick_plot <- make_plot(sat_select_dat, time_now, sat_select, hits_per_wap_semester_by_building_max) | |
| output_text <- busy_text(sat_hr_dat, sat_hr_dat$Building, hits_per_wap_semester_by_building_max) | |
| sat_map_info <- get_map_info(sat_dat, time_now, hits_per_wap_semester_by_building_max) | |
| leaf_map <- get_map(sat_map_info) | |
| output$satMap <- renderLeaflet({leaf_map}) | |
| output$sat_plot <- renderPlot({hr_pick_plot}, bg="transparent") | |
| output$sat_info <- renderUI({p("At", as.numeric(sat_hr_dat$Hour), ":00,",sat_select, "is", output_text)}) | |
| } else { | |
| sat_hr_dat <- sat_select_dat[floor(sat_react_click$Clicks)+1,] | |
| output_text <- busy_text(sat_hr_dat, sat_hr_dat$Building, hits_per_wap_semester_by_building_max) | |
| # time_now <- as.integer(sat_react_click$Clicks) | |
| time_now <- sat_hr_dat$Hour | |
| sat_map_info <- get_map_info(sat_dat, time_now, hits_per_wap_semester_by_building_max) | |
| leaf_map <- get_map(sat_map_info) | |
| output$satMap <- renderLeaflet({leaf_map}) | |
| hr_pick_plot <- make_plot(sat_select_dat, time_now, sat_select, hits_per_wap_semester_by_building_max) | |
| output$sat_plot <- renderPlot({hr_pick_plot}, bg="transparent") | |
| output$sat_info <- renderUI({p("At", as.numeric(sat_hr_dat$Hour), ":00,", sat_select,"is", output_text)}) | |
| } | |
| }) | |
| }) | |
| ##INITIAL POP-UP WARNING | |
| # Content of modal dialog | |
| query_modal <- modalDialog( | |
| title = tags$div(HTML("<h2><span style = 'color: #54585a; text-transform: capitalize;'>Welcome to RPI</span><b><span style = 'color: #990000; text-transform: capitalize;' > StudySafe</span></b></h2>")), | |
| tags$div(HTML("<span style = 'font-weight: 400;color: #6e6e6e;'> | |
| <p><b>WARNING:</b> 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). | |
| <i>Use at your own risk.</i></p> | |
| </span> ")), | |
| 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) |