diff --git a/app.R b/app.R
index 4c639c98..ec8ec18e 100644
--- a/app.R
+++ b/app.R
@@ -4,17 +4,20 @@
# Edited by Kara Kniss
# Version: 15 Mar 2021
+options(dplyr.summarise.inform = FALSE)
+options(tidyverse.quiet = TRUE)
+Sys.setenv(TZ="America/New_York")
+
#document for reading in the relevant libraries, data, and cleaning
-source('read_wapData.R')
+source('read_wapData_sc.R')
# Suppress those dplyr warnings
-options(dplyr.summarise.inform = FALSE)
#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')
+usability_study_url <- tags$a("usability study", href = "https://docs.google.com/forms/d/e/1FAIpQLSdum3EcOfvvXb0MUqC6jnkBMVCQDwfoeUpk8672_k7MnA0aPw/viewform?usp=pp_url", style = 'color: #990000; background-color: #FAFAFA')
ui <- dashboardPage(skin = "black", title = "RPI StudySafe",
@@ -143,43 +146,28 @@ ui <- dashboardPage(skin = "black", title = "RPI StudySafe",
# Find a place to study
tabItem(tabName = "week_activity",
- uiOutput("week_view"),
tags$div(HTML("
")),
fluidRow(column(h4(textOutput('MT_title_summary'), style = 'color: #d6001c'),width =12)),
- tags$style(type = "text/css", "#campusMap {height: calc(100vh - 80px) !important;}"),
leafletOutput("campusMap"),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 = 'building_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),
- tabsetPanel(id="week_tab",
- tabPanel("Sunday", tabName="sunday", br(),
- uiOutput("sun_info", align = "center"),
- br(), plotOutput("sun_plot", click = "sun_click")),
- tabPanel("Monday", tabName="monday", br(),
- uiOutput("mon_info", align = "center"),
- br(), plotOutput("mon_plot", click = "mon_click")),
- tabPanel("Tuesday", tabName="tuesday", br(),
- uiOutput("tue_info", align = "center"),
- br(), plotOutput("tue_plot", click = "tue_click")),
- tabPanel("Wednesday", tabName="wednesday", br(),
- uiOutput("wed_info", align = "center"),
- br(), plotOutput("wed_plot", click = "wed_click")),
- tabPanel("Thursday", tabName="thursday", br(),
- uiOutput("thu_info", align = "center"),
- br(), plotOutput("thu_plot", click = "thu_click")),
- tabPanel("Friday", tabName="friday", br(),
- uiOutput("fri_info", align = "center"),
- br(), plotOutput("fri_plot", click = "fri_click")),
- tabPanel("Saturday", tabName="saturday", br(),
- uiOutput("sat_info", align = "center"),
- br(), plotOutput("sat_plot", click = "sat_click")))),
+ tags$style(type = "text/css", "#campusMap {height: 60vh !important;}"),
+ tags$style(type='text/css', "#click_on_map {text-align:center; font-size: 25px;}"),
+ textOutput("click_on_map"),
+ tags$style(type="text/css", '#barPanel {width: 60vw; margin: auto;}'),
+ # shinyjs::hidden(
+ tags$div(id = "barPanel",
+ fluidRow(column(width = 6, h2("Find a Place to Study")),
+ column(width = 6, div(style = "display:inline-block; float:right", actionButton(inputId = "submit_find", label = "Close Panel")))),
+ fluidRow(column(width = 6, pickerInput(inputId = 'user_selected_building', label = tags$div(HTML("Choose a Building")),
+ options = list(`live-search` = TRUE),
+ choices = byCat_single)),
+ column(width = 6, pickerInput(inputId = "user_selected_day", label = tags$div(HTML("Choose a Day")),
+ choices = weekdays(Sys.Date()+0:6)))),
+ prettySwitch(inputId = 'byActivity', inline = TRUE,
+ label= tags$div(HTML("List by Activity")),
+ value = FALSE, status = "default", fill = TRUE, bigger = TRUE),
+ uiOutput("busy_info", align = "center"),
+ plotOutput("hourly_crowd", click = "pick_time", height="20vh"),
+ h1("StudySafe uses near-real-time, anonymous WiFi data from the last 7 days")),
)
),
@@ -201,316 +189,84 @@ ui <- dashboardPage(skin = "black", title = "RPI StudySafe",
# Define server logic required
server <- function(input, output, session) {
- #ABOUT TAB
- output$about_body <- renderUI({})
-
- # FIND A PLACE TO STUDY
- # Set default tab to today's weekday
- observe({
- weekday_now <- weekdays(Sys.Date())
- updateTabsetPanel(session,"week_tab", selected = weekday_now)
- })
-
#Activity Tagging Switch
- observe({
+ observeEvent(input$byActivity, {
if (input$byActivity == FALSE) {
- updatePickerInput(session, inputId = "building_selected", choices = byCat_single)
+ updatePickerInput(session, inputId = "user_selected_building", choices = byCat_single, selected = input$user_selected_building)
} else {
- updatePickerInput(session, inputId = "building_selected", choices = byAct_single)
+ updatePickerInput(session, inputId = "user_selected_building", choices = byAct_single, selected = input$user_selected_building)
}
})
- output$week_view <- renderUI({
-
- weekday_now <- weekdays(Sys.Date())
-
- observe({
- building_selected$building <- input$building_selected
- })
-
- building_select <- building_selected$building
- map_lat <- map_latitude$lat
- map_lng <- map_longitude$lng
- time_now <- hr_now$time
- icon <- awesomeIcons(icon = 'ios-close', iconColor="black", library='ion', markerColor="green")
-
- # Update marker color
- observe({
- map_info <- sun_dat %>% filter(Building==building_select) %>% select(lat,lng)
- map_latitude$lat <- as.numeric(map_info[1,1])
- map_longitude$lng <- as.numeric(map_info[1,2])
- leafletProxy("campusMap") %>% clearGroup(group="selected") %>% addAwesomeMarkers(icon= icon, lat=map_lat, lng=map_lng, group="selected")
- })
-
- # Update map marker and barplot based on building selected (via map and drop-down)
- # observe({
- # req(input$campusMap_marker_click)
- # building_selected$building <- input$building_selected
- # clicks <- data.frame(input$campusMap_marker_click[3:4])
- # new_select <- sun_dat %>% filter(lng==clicks[,2], lat==clicks[,1]) %>% select(Building)
- # new_select <- as.character(new_select[1,1])
- # updatePickerInput(session, inputId="building_selected", selected=new_select)
- # if (new_select != input$building_selected){
- # new_select <- input$building_selected
- # }
- # map_info <- sun_dat %>% filter(Building==new_select) %>% select(lat,lng)
- # map_latitude$lat <- as.numeric(map_info[1,1])
- # map_longitude$lng <- as.numeric(map_info[1,2])
- # leafletProxy("campusMap") %>% clearGroup(group="selected") %>% addAwesomeMarkers(icon= icon, lat=map_lat, lng=map_lng, group="selected")
- # })
- #
-
- # Update leaflet if change tab
- observe({
- if (input$week_tab == "Sunday"){
- if (!is.null(sun_react_click$Clicks)){hr_now$time <- floor(sun_react_click$Clicks)}
- time_now <- hr_now$time
- map_info <- get_map_info(sun_dat, time_now, hits_per_wap_semester_by_building_max)
- leaf_map <- get_map(map_info)
- output$campusMap <- renderLeaflet({leaf_map})
- leafletProxy("campusMap") %>% clearGroup(group="selected") %>% addAwesomeMarkers(icon= icon, lat=map_lat, lng=map_lng, group="selected")
- } else if (input$week_tab == "Monday"){
- if (!is.null(mon_react_click$Clicks)){hr_now$time <- floor(mon_react_click$Clicks)}
- time_now <- hr_now$time
- map_info <- get_map_info(mon_dat, time_now, hits_per_wap_semester_by_building_max)
- leaf_map <- get_map(map_info)
- output$campusMap <- renderLeaflet({leaf_map})
- leafletProxy("campusMap") %>% clearGroup(group="selected") %>% addAwesomeMarkers(icon= icon, lat=map_lat, lng=map_lng, group="selected")
- } else if (input$week_tab == "Tuesday"){
- if (!is.null(tue_react_click$Clicks)){hr_now$time <- floor(tue_react_click$Clicks)}
- time_now <- hr_now$time
- map_info <- get_map_info(tue_dat, time_now, hits_per_wap_semester_by_building_max)
- leaf_map <- get_map(map_info)
- output$campusMap <- renderLeaflet({leaf_map})
- leafletProxy("campusMap") %>% clearGroup(group="selected") %>% addAwesomeMarkers(icon= icon, lat=map_lat, lng=map_lng, group="selected")
- } else if (input$week_tab == "Wednesday"){
- if (!is.null(wed_react_click$Clicks)){hr_now$time <- floor(wed_react_click$Clicks)}
- time_now <- hr_now$time
- map_info <- get_map_info(wed_dat, time_now, hits_per_wap_semester_by_building_max)
- leaf_map <- get_map(map_info)
- output$campusMap <- renderLeaflet({leaf_map})
- leafletProxy("campusMap") %>% clearGroup(group="selected") %>% addAwesomeMarkers(icon= icon, lat=map_lat, lng=map_lng, group="selected")
- } else if (input$week_tab == "Thursday"){
- if (!is.null(thu_react_click$Clicks)){hr_now$time <- floor(thu_react_click$Clicks)}
- time_now <- hr_now$time
- map_info <- get_map_info(thu_dat, time_now, hits_per_wap_semester_by_building_max)
- leaf_map <- get_map(map_info)
- output$campusMap <- renderLeaflet({leaf_map})
- leafletProxy("campusMap") %>% clearGroup(group="selected") %>% addAwesomeMarkers(icon= icon, lat=map_lat, lng=map_lng, group="selected")
- } else if (input$week_tab == "Friday"){
- if (!is.null(fri_react_click$Clicks)){hr_now$time <- floor(fri_react_click$Clicks)}
- time_now <- hr_now$time
- map_info <- get_map_info(fri_dat, time_now, hits_per_wap_semester_by_building_max)
- leaf_map <- get_map(map_info)
- output$campusMap <- renderLeaflet({leaf_map})
- leafletProxy("campusMap") %>% clearGroup(group="selected") %>% addAwesomeMarkers(icon= icon, lat=map_lat, lng=map_lng, group="selected")
- } else if (input$week_tab == "Saturday") {
- if (!is.null(sat_react_click$Clicks)){hr_now$time <- floor(sat_react_click$Clicks)}
- time_now <- hr_now$time
- map_info <- get_map_info(sat_dat, time_now, hits_per_wap_semester_by_building_max)
- leaf_map <- get_map(map_info)
- output$campusMap <- renderLeaflet({leaf_map})
- leafletProxy("campusMap") %>% clearGroup(group="selected") %>% addAwesomeMarkers(icon= icon, lat=map_lat, lng=map_lng, group="selected")
- }
- })
-
- # 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
- })
-
- # Create the bar plot
- observe({
- sun_select_dat <- sun_dat %>% filter(Building == building_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, building_select, hits_per_wap_semester_by_building_max)
- output_text <- busy_text(sun_hr_dat, sun_hr_dat$Building, hits_per_wap_semester_by_building_max)
- output$sun_plot <- renderPlot({hr_pick_plot}, bg="transparent")
- time_ampm <- time.data[time_now+1,2]
- output$sun_info <- renderUI({p("At", time_ampm, " ", building_select,"is", output_text)})
- output$MT_title_summary <- renderText({stringr::str_c("RPI on ", input$week_tab,' at ', time_ampm)})
- } else {
- sun_hr_dat <- sun_select_dat[time_now,]
- output_text <- busy_text(sun_hr_dat, sun_hr_dat$Building, hits_per_wap_semester_by_building_max)
- hr_pick_plot <- make_plot(sun_select_dat, time_now, building_select, hits_per_wap_semester_by_building_max)
- output$sun_plot <- renderPlot({hr_pick_plot}, bg="transparent")
- time_ampm <- time.data[time_now+1,2]
- output$sun_info <- renderUI({p("At", time_ampm, " ", building_select,"is", output_text)})
- output$MT_title_summary <- renderText({stringr::str_c("RPI on ", input$week_tab,' at ', time_ampm)})
- }
- })
-
- # Monday Tab
- mon_react_click <- reactiveValues(Clicks=NULL)
- observeEvent(input$mon_click, {
- click <- as.numeric(input$mon_click$x) - as.numeric(input$mon_click$domain$left)
- mon_react_click$Clicks <- click
- })
-
- observe({
- mon_select_dat <- mon_dat %>% filter(Building == building_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, building_select, hits_per_wap_semester_by_building_max)
- output_text <- busy_text(mon_hr_dat, mon_hr_dat$Building, hits_per_wap_semester_by_building_max)
- output$mon_plot <- renderPlot({hr_pick_plot}, bg="transparent")
- time_ampm <- time.data[time_now+1,2]
- output$mon_info <- renderUI({p("At", time_ampm, " ", building_select,"is", output_text)})
- output$MT_title_summary <- renderText({stringr::str_c("RPI on ", input$week_tab,' at ', time_ampm)})
- } else {
- mon_hr_dat <- mon_select_dat[time_now+1,]
- output_text <- busy_text(mon_hr_dat, mon_hr_dat$Building, hits_per_wap_semester_by_building_max)
- hr_pick_plot <- make_plot(mon_select_dat, time_now, building_select, hits_per_wap_semester_by_building_max)
- output$mon_plot <- renderPlot({hr_pick_plot}, bg="transparent")
- time_ampm <- time.data[time_now+1,2]
- output$mon_info <- renderUI({p("At", time_ampm, " ", building_select,"is", output_text)})
- output$MT_title_summary <- renderText({stringr::str_c("RPI on ", input$week_tab,' at ', time_ampm)})
- }
- })
-
- # Tuesday Tab
- tue_react_click <- reactiveValues(Clicks=NULL)
- observeEvent(input$tue_click, {
- click <- as.numeric(input$tue_click$x) - as.numeric(input$tue_click$domain$left)
- tue_react_click$Clicks <- click
- })
-
- observe({
- tue_select_dat <- tue_dat %>% filter(Building == building_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, building_select, hits_per_wap_semester_by_building_max)
- output_text <- busy_text(tue_hr_dat, tue_hr_dat$Building, hits_per_wap_semester_by_building_max)
- output$tue_plot <- renderPlot({hr_pick_plot}, bg="transparent")
- time_ampm <- time.data[time_now+1,2]
- output$tue_info <- renderUI({p("At", time_ampm, " ", building_select,"is", output_text)})
- output$MT_title_summary <- renderText({stringr::str_c("RPI on ", input$week_tab,' at ', time_ampm)})
- } else {
- tue_hr_dat <- tue_select_dat[time_now+1,]
- output_text <- busy_text(tue_hr_dat, tue_hr_dat$Building, hits_per_wap_semester_by_building_max)
- hr_pick_plot <- make_plot(tue_select_dat, time_now, building_select, hits_per_wap_semester_by_building_max)
- output$tue_plot <- renderPlot({hr_pick_plot}, bg="transparent")
- time_ampm <- time.data[time_now+1,2]
- output$tue_info <- renderUI({p("At", time_ampm, " ", building_select,"is", output_text)})
- output$MT_title_summary <- renderText({stringr::str_c("RPI on ", input$week_tab,' at ', 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
- })
-
- observe({
- wed_select_dat <- wed_dat %>% filter(Building == building_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, building_select, hits_per_wap_semester_by_building_max)
- output_text <- busy_text(wed_hr_dat, wed_hr_dat$Building, hits_per_wap_semester_by_building_max)
- output$wed_plot <- renderPlot({hr_pick_plot}, bg="transparent")
- time_ampm <- time.data[time_now+1,2]
- output$wed_info <- renderUI({p("At", time_ampm, " ", building_select,"is", output_text)})
- output$MT_title_summary <- renderText({stringr::str_c("RPI on ", input$week_tab,' at ', time_ampm)})
- } else {
- wed_hr_dat <- wed_select_dat[time_now+1,]
- output_text <- busy_text(wed_hr_dat, wed_hr_dat$Building, hits_per_wap_semester_by_building_max)
- hr_pick_plot <- make_plot(wed_select_dat, time_now, building_select, hits_per_wap_semester_by_building_max)
- output$wed_plot <- renderPlot({hr_pick_plot}, bg="transparent")
- time_ampm <- time.data[time_now+1,2]
- output$wed_info <- renderUI({p("At", time_ampm, " ", building_select,"is", output_text)})
- output$MT_title_summary <- renderText({stringr::str_c("RPI on ", input$week_tab,' at ', time_ampm)})
- }
- })
-
- # Thursday Tab
- thu_react_click <- reactiveValues(Clicks=NULL)
- observeEvent(input$thu_click, {
- click <- as.numeric(input$thu_click$x) - as.numeric(input$thu_click$domain$left)
- thu_react_click$Clicks <- click
- })
-
- observe({
- thu_select_dat <- thu_dat %>% filter(Building == building_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, building_select, hits_per_wap_semester_by_building_max)
- output_text <- busy_text(thu_hr_dat, thu_hr_dat$Building, hits_per_wap_semester_by_building_max)
- output$thu_plot <- renderPlot({hr_pick_plot}, bg="transparent")
- time_ampm <- time.data[time_now+1,2]
- output$thu_info <- renderUI({p("At", time_ampm, " ", building_select,"is", output_text)})
- output$MT_title_summary <- renderText({stringr::str_c("RPI on ", input$week_tab,' at ', time_ampm)})
- } else {
- thu_hr_dat <- thu_select_dat[time_now+1,]
- output_text <- busy_text(thu_hr_dat, thu_hr_dat$Building, hits_per_wap_semester_by_building_max)
- hr_pick_plot <- make_plot(thu_select_dat, time_now, building_select, hits_per_wap_semester_by_building_max)
- output$thu_plot <- renderPlot({hr_pick_plot}, bg="transparent")
- time_ampm <- time.data[time_now+1,2]
- output$thu_info <- renderUI({p("At", time_ampm, " ", building_select,"is", output_text)})
- output$MT_title_summary <- renderText({stringr::str_c("RPI on ", input$week_tab,' at ', time_ampm)})
- }
- })
-
- # Friday Tab
- fri_react_click <- reactiveValues(Clicks=NULL)
- observeEvent(input$fri_click, {
- click <- as.numeric(input$fri_click$x) - as.numeric(input$fri_click$domain$left)
- fri_react_click$Clicks <- click
- })
-
- observe({
- fri_select_dat <- fri_dat %>% filter(Building == building_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, building_select, hits_per_wap_semester_by_building_max)
- output_text <- busy_text(fri_hr_dat, fri_hr_dat$Building, hits_per_wap_semester_by_building_max)
- output$fri_plot <- renderPlot({hr_pick_plot}, bg="transparent")
- time_ampm <- time.data[time_now+1,2]
- output$fri_info <- renderUI({p("At", time_ampm, " ", building_select,"is", output_text)})
- output$MT_title_summary <- renderText({stringr::str_c("RPI on ", input$week_tab,' at ', time_ampm)})
- } else {
- fri_hr_dat <- fri_select_dat[time_now+1,]
- output_text <- busy_text(fri_hr_dat, fri_hr_dat$Building, hits_per_wap_semester_by_building_max)
- hr_pick_plot <- make_plot(fri_select_dat, time_now, building_select, hits_per_wap_semester_by_building_max)
- output$fri_plot <- renderPlot({hr_pick_plot}, bg="transparent")
- time_ampm <- time.data[time_now+1,2]
- output$fri_info <- renderUI({p("At", time_ampm, " ", building_select,"is", output_text)})
- output$MT_title_summary <- renderText({stringr::str_c("RPI on ", input$week_tab,' at ', time_ampm)})
- }
- })
-
- # Saturday Tab
- sat_react_click <- reactiveValues(Clicks=NULL)
- observeEvent(input$sat_click, {
- click <- as.numeric(input$sat_click$x) - as.numeric(input$sat_click$domain$left)
- sat_react_click$Clicks <- click
- })
-
- observe({
- sat_select_dat <- sat_dat %>% filter(Building == building_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, building_select, hits_per_wap_semester_by_building_max)
- output_text <- busy_text(sat_hr_dat, sat_hr_dat$Building, hits_per_wap_semester_by_building_max)
- output$sat_plot <- renderPlot({hr_pick_plot}, bg="transparent")
- time_ampm <- time.data[time_now+1,2]
- output$sat_info <- renderUI({p("At", time_ampm, " ", building_select,"is", output_text)})
- output$MT_title_summary <- renderText({stringr::str_c("RPI on ", input$week_tab,' at ', time_ampm)})
- } else {
- sat_hr_dat <- sat_select_dat[time_now+1,]
- output_text <- busy_text(sat_hr_dat, sat_hr_dat$Building, hits_per_wap_semester_by_building_max)
- hr_pick_plot <- make_plot(sat_select_dat, time_now, building_select, hits_per_wap_semester_by_building_max)
- output$sat_plot <- renderPlot({hr_pick_plot}, bg="transparent")
- time_ampm <- time.data[time_now+1,2]
- output$sat_info <- renderUI({p("At", time_ampm, " ", building_select,"is", output_text)})
- output$MT_title_summary <- renderText({stringr::str_c("RPI on ", input$week_tab,' at ', time_ampm)})
- }
- })
+ application_state <- reactiveValues()
+ # set the initial application state
+ application_state$day <- weekdays(Sys.Date())[1]
+ application_state$time <- as.integer(format(Sys.time(), "%H"))
+ application_state$building <- "Amos Eaton"
+
+ output$click_on_map <- renderText({paste("Click on any marker on the map for more information!")})
+
+ # if the user selected day changes, update the application state
+ observeEvent(input$user_selected_day, {
+ application_state$day <- input$user_selected_day
+ })
+
+ # if the user selected time changes, update the application state
+ observeEvent(input$pick_time, {
+ # shiny returns the time in input$pick time since it's what we used as the axis
+ application_state$time <- floor(as.numeric(input$pick_time$x) - as.numeric(input$pick_time$domain$left))
+ })
+
+ # if the user selected building changes, update the application state
+ observeEvent(input$user_selected_building, {
+ application_state$building <- input$user_selected_building
+ })
+
+ # if the user clicks a building on the map, update the picker
+ # updatePickerInput updates input$user_selected building which triggers the above observer and updates the application state
+ observeEvent(input$campusMap_marker_click, {
+ # get the buliding clicked from the lat and long of the marker
+ clicked_lat = input$campusMap_marker_click$lat
+ clicked_lng = input$campusMap_marker_click$lng
+ data <- rpi_wap_last7 %>% filter(weekday == application_state$day & lng == clicked_lng & lat == clicked_lat)
+ building <- (data$Building)[1]
+ updatePickerInput(session, inputId="user_selected_building", selected=building)
+ leafletProxy("campusMap") %>% clearGroup(group="selected") %>% addAwesomeMarkers(icon= icon, lat=clicked_lat, lng=clicked_lng, group="selected")
+ shinyjs::showElement(id= "barPanel")
+ shinyjs::hide("click_on_map")
+ })
+
+ observeEvent(input$submit_find, {
+ shinyjs::hideElement(id= "barPanel")
+ shinyjs::show("click_on_map")
+ })
+
+ # main leaflet map
+ output$campusMap <- renderLeaflet({
+ data <- rpi_wap_last7 %>% filter(weekday == application_state$day)
+ point <- data %>% filter(Building == application_state$building) %>% select(lat,lng) %>% unique()
+ map_info <- get_map_info(data, application_state$time, hits_per_wap_semester_by_building_max)
+ leaf_map <- get_map(map_info, point$lat, point$lng)
+ leaf_map %>% addAwesomeMarkers(icon= icon, lat=point$lat, lng=point$lng, group="selected")
+ })
+
+ # "google-maps" style plot
+ output$hourly_crowd <- renderPlot({
+ # get data to feed into make_plot
+ data <- rpi_wap_last7 %>% filter(weekday == application_state$day & Building == application_state$building)
+ make_plot(data, application_state$time, application_state$building, hits_per_wap_semester_by_building_max)
+ }, bg="transparent")
+
+ output$busy_info <- renderUI({
+ data <- rpi_wap_last7 %>% filter(weekday == application_state$day & Hour == application_state$time & Building == application_state$building)
+ text <- busy_text(data, application_state$building, hits_per_wap_semester_by_building_max)
+ time_ampm <- time.data[application_state$time+1,2]
+ p("At", time_ampm, " ", application_state$building,"is", text)
+ })
+
+ output$MT_title_summary <- renderText({
+ time_ampm <- time.data[application_state$time+1,2]
+ stringr::str_c("RPI on ", application_state$day,' at ', time_ampm)
})
##INITIAL POP-UP WARNING
@@ -539,4 +295,4 @@ server <- function(input, output, session) {
}
# Run the application
-shinyApp(ui = ui, server = server)
\ No newline at end of file
+shinyApp(ui = ui, server = server)
diff --git a/read_wapData.R b/read_wapData.R
index 4b49e12d..0a70237f 100644
--- a/read_wapData.R
+++ b/read_wapData.R
@@ -15,12 +15,14 @@ if (length(new.packages) > 0) {
library(shiny)
library(shinydashboard)
library(shinyjs)
+library(DT)
+library(dplyr)
library(ggplot2)
library(shinyWidgets)
library(tidyverse)
library(tidyr)
library(lubridate)
-library(plyr)
+#library(plyr)
library(scales)
library(zoo)
library(ggalt)
@@ -28,20 +30,18 @@ library(leaflet)
library(plotly)
library(wesanderson)
library(reactable)
-library(DT)
-library(dplyr)
################################################################################################################
###READING IN NECESSARY FILES
################################################################################################################
#rpi_wap_raw(one month): Min_30, devname, maccount, usercount, datetime, date_time, Date, Building, Floor, Room, latitude, longitude, buldingType, abbrev, time
-rpi_wap_raw <- readRDS("../COVID_RPI_WiFi_Data/rpi_wap_raw.rds")
+rpi_wap_raw <- readRDS("./data/rpi_wap_raw.rds")
#combined_wap_data(one month): building, time, Date, latitude, longitude, buildingType, abbrev, users, macs,
-combined_wap_data <- readRDS("../COVID_RPI_WiFi_Data/combined_wap_data.rds")
+combined_wap_data <- readRDS("./data/combined_wap_data.rds")
#rpi_wap_stats: devname, Day, maccount_mean, maccount_med, maccount_max, usrecount_mean, usercount_med, usercount_max
-rpi_wap_stats <- readRDS("../COVID_RPI_WiFi_Data/rpi_wifi_semester_day_summary.rds")
+rpi_wap_stats <- readRDS("./data/rpi_wifi_semester_day_summary.rds")
#rpi_wap_week(whole semester): devname, maccount, usercount, datetime, date_time, Date, Day
#rpi_wap_week <- readRDS("../COVID_RPI_WiFi_Data/rpi_wifi_semester_extended.rds")
@@ -102,10 +102,12 @@ min_time_of_min_date <- min(rpi_wap_last7[rpi_wap_last7$Date == min(rpi_wap_last
date_app <- reactiveValues(date = max_date) # Remember the input date for future use
time_app <- reactiveValues(time = 0) # Remember the input time for future use
building_selected <- reactiveValues(building = 'Amos Eaton') # Remember the name of selected building for future use
+data <- reactiveValues(clickedMarker=NULL)
map_latitude <- reactiveValues(lat=0)
map_longitude <- reactiveValues(lng=0)
hr <- as.integer(format(Sys.time(), "%H"))
hr_now <- reactiveValues(time=hr)
+map_click <- reactive({"Amos Eaton"})
#weekday information
#getting selected weekday
@@ -285,11 +287,11 @@ getIcon <- function(dat){
}
# Function to generate leaflet map
-get_map <- function(dat) {
+get_map <- function(dat, lat, lng) {
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%"))
+ addTiles() %>%setView( lng = lng, lat = lat, zoom = 16 ) %>%
+ addLegend(position = "topleft", colors = c("#235878", "#65b7de", "#f28e80", "#c44130"), labels = c("0% ~ 25%", "25% ~ 50%", "50% ~ 75%", "75% ~ 100%"))
}
# Function to generate comments on how busy the building is
@@ -332,3 +334,4 @@ make_plot <- function(dat, time_now, building_select, hits_per_wap_semester_by_b
legend.position="none")
}
+icon <- awesomeIcons(icon = 'ios-close', iconColor="black", library='ion', markerColor="green")