From 77be30d4482a9ae6ce3b05ae15172466c25e44f5 Mon Sep 17 00:00:00 2001 From: chenc29 Date: Thu, 18 Mar 2021 10:48:05 -0400 Subject: [PATCH 1/3] move side panel, add comment, update link --- app.R | 55 +++++++++++++++++++++++++------------------------- read_wapData.R | 2 +- 2 files changed, 29 insertions(+), 28 deletions(-) diff --git a/app.R b/app.R index 4c639c98..5ab672a8 100644 --- a/app.R +++ b/app.R @@ -14,7 +14,7 @@ options(dplyr.summarise.inform = FALSE) 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", @@ -146,11 +146,11 @@ ui <- dashboardPage(skin = "black", title = "RPI StudySafe", 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;}"), + tags$style(type = "text/css", "#campusMap {height: calc(100vh - 100px) !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", + draggable = TRUE, top = "50vh", left = "auto", right = "auto", bottom = "auto", + width = "60vw", height = "auto", h2("Find a Place to Study"), pickerInput(inputId = 'building_selected', label = tags$div(HTML("Choose a Building")), options = list(`live-search` = TRUE), @@ -158,28 +158,30 @@ ui <- dashboardPage(skin = "black", title = "RPI StudySafe", prettySwitch(inputId = 'byActivity', inline = TRUE, label= tags$div(HTML("List by Activity")), value = FALSE, status = "default", fill = TRUE, bigger = TRUE), + tags$div(HTML(" +

StudySafe uses near-real-time, anonymous WiFi data from the last 7 days

 ")), tabsetPanel(id="week_tab", tabPanel("Sunday", tabName="sunday", br(), uiOutput("sun_info", align = "center"), - br(), plotOutput("sun_plot", click = "sun_click")), + br(), plotOutput("sun_plot", click = "sun_click", height="20vh")), tabPanel("Monday", tabName="monday", br(), uiOutput("mon_info", align = "center"), - br(), plotOutput("mon_plot", click = "mon_click")), + br(), plotOutput("mon_plot", click = "mon_click", height="20vh")), tabPanel("Tuesday", tabName="tuesday", br(), uiOutput("tue_info", align = "center"), - br(), plotOutput("tue_plot", click = "tue_click")), + br(), plotOutput("tue_plot", click = "tue_click", height="20vh")), tabPanel("Wednesday", tabName="wednesday", br(), uiOutput("wed_info", align = "center"), - br(), plotOutput("wed_plot", click = "wed_click")), + br(), plotOutput("wed_plot", click = "wed_click", height="20vh")), tabPanel("Thursday", tabName="thursday", br(), uiOutput("thu_info", align = "center"), - br(), plotOutput("thu_plot", click = "thu_click")), + br(), plotOutput("thu_plot", click = "thu_click", height="20vh")), tabPanel("Friday", tabName="friday", br(), uiOutput("fri_info", align = "center"), - br(), plotOutput("fri_plot", click = "fri_click")), + br(), plotOutput("fri_plot", click = "fri_click", height="20vh")), tabPanel("Saturday", tabName="saturday", br(), uiOutput("sat_info", align = "center"), - br(), plotOutput("sat_plot", click = "sat_click")))), + br(), plotOutput("sat_plot", click = "sat_click", height="20vh")))), ) ), @@ -227,21 +229,7 @@ server <- function(input, output, session) { 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) @@ -258,7 +246,20 @@ server <- function(input, output, session) { # 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") # }) - # + + 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 leaflet if change tab observe({ diff --git a/read_wapData.R b/read_wapData.R index 4b49e12d..58866010 100644 --- a/read_wapData.R +++ b/read_wapData.R @@ -288,7 +288,7 @@ getIcon <- function(dat){ get_map <- function(dat) { leaf_map <- leaflet(dat) %>% addAwesomeMarkers(icon=getIcon(dat)) %>% - addTiles() %>%setView( lng = -73.6789, lat = 42.7298, zoom = 16 ) %>% + addTiles() %>%setView( lng = -73.6744444, lat = 42.7283333, zoom = 16 ) %>% addLegend(position = "topleft", colors = c("#235878", "#65b7de", "#f28e80", "#c44130"), labels = c("0% ~ 25%", "25% ~ 50%", "50% ~ 75%", "75% ~ 100%")) } From 0acd07c2a15a4d9c925e566b270b2793523c32d1 Mon Sep 17 00:00:00 2001 From: "Chen, Tracy" Date: Mon, 12 Apr 2021 18:21:43 -0400 Subject: [PATCH 2/3] Update app.R --- app.R | 439 +++++++++++++--------------------------------------------- 1 file changed, 97 insertions(+), 342 deletions(-) diff --git a/app.R b/app.R index 5ab672a8..ec8ec18e 100644 --- a/app.R +++ b/app.R @@ -4,11 +4,14 @@ # 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') @@ -143,45 +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 - 100px) !important;}"), leafletOutput("campusMap"),br(), - absolutePanel(id = "controls", class = "panel panel-default", fixed = TRUE, - draggable = TRUE, top = "50vh", left = "auto", right = "auto", bottom = "auto", - width = "60vw", 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), - tags$div(HTML(" -

StudySafe uses near-real-time, anonymous WiFi data from the last 7 days

 ")), - tabsetPanel(id="week_tab", - tabPanel("Sunday", tabName="sunday", br(), - uiOutput("sun_info", align = "center"), - br(), plotOutput("sun_plot", click = "sun_click", height="20vh")), - tabPanel("Monday", tabName="monday", br(), - uiOutput("mon_info", align = "center"), - br(), plotOutput("mon_plot", click = "mon_click", height="20vh")), - tabPanel("Tuesday", tabName="tuesday", br(), - uiOutput("tue_info", align = "center"), - br(), plotOutput("tue_plot", click = "tue_click", height="20vh")), - tabPanel("Wednesday", tabName="wednesday", br(), - uiOutput("wed_info", align = "center"), - br(), plotOutput("wed_plot", click = "wed_click", height="20vh")), - tabPanel("Thursday", tabName="thursday", br(), - uiOutput("thu_info", align = "center"), - br(), plotOutput("thu_plot", click = "thu_click", height="20vh")), - tabPanel("Friday", tabName="friday", br(), - uiOutput("fri_info", align = "center"), - br(), plotOutput("fri_plot", click = "fri_click", height="20vh")), - tabPanel("Saturday", tabName="saturday", br(), - uiOutput("sat_info", align = "center"), - br(), plotOutput("sat_plot", click = "sat_click", height="20vh")))), + 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")), ) ), @@ -203,315 +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 - }) - - # 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") - # }) - - 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 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 @@ -540,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) From 89b55f29590754f2970c5e3a94d72b9494e0b8ab Mon Sep 17 00:00:00 2001 From: "Chen, Tracy" Date: Mon, 12 Apr 2021 18:22:23 -0400 Subject: [PATCH 3/3] Update read_wapData.R --- read_wapData.R | 21 ++++++++++++--------- 1 file changed, 12 insertions(+), 9 deletions(-) diff --git a/read_wapData.R b/read_wapData.R index 58866010..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.6744444, lat = 42.7283333, 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")