Skip to content
Permalink
master
Switch branches/tags

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-SafeCampus/app.R

Go to file
 
 
Cannot retrieve contributors at this time
executable file 1727 lines (1646 sloc) 88.4 KB
Raw Blame
Open in GitHub Desktop
# Data Incite SafeCampus App
# Uses Shinydashboard as a framework https://rstudio.github.io/shinydashboard/
# Created by Jennifer Zhan, Tracy Chen, Christina van Hal, and Mia Mayerhofer
# Version: 26 Jan 2021
#load the packages if they are not already loaded
packages <- c("shiny", "shinydashboard", "shinyjs", "tidyr", "ggplot2", "shinyWidgets", "tidyverse",
"viridis", "hrbrthemes", "lubridate", "repr", "leaflet", "rlist", "stringi", "plotly",
"shinyBS", "DBI", "RSQLite", "RMySQL")
new.packages <- packages[!(packages %in% installed.packages()[,"Package"])]
if (length(new.packages) > 0) {
install.packages(new.packages)
}
#loading required libraries
library(shiny)
library(shinydashboard)
library(shinyjs)
library(tidyr)
library(ggplot2)
library(shinyWidgets)
library(tidyverse)
library(viridis)
library(hrbrthemes)
library(lubridate)
library(repr)
library(leaflet)
library(rlist)
library(stringi)
library(plotly)
library(shinyBS)
library(DBI)
library(RSQLite)
library(ggridges)
library(RMySQL)
##loading R script
#source("building_info.R", chdir = TRUE)
combined_wap_data <- readRDS("../COVID_RPI_WiFi_Data/combined_wap_data.rds")
rpi_wap_raw <- readRDS("../COVID_RPI_WiFi_Data/rpi_wap_raw.rds")
buildinginfo <- readRDS("../COVID_RPI_WiFi_Data/buildinginfo.rds")
min_30 <- readRDS("../COVID_RPI_WiFi_Data/Min_30_time.Rds")
allinfo <- readRDS("../COVID_RPI_WiFi_Data/allinfo.Rds")
#loading R script
source("building_info.R", local = TRUE)
ui <- dashboardPage(skin = "black", title = "COVID SafeCampus",
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"),
#HTML("<p style='display: inline; font-size: 1.2em; vertical-align: middle;'>COVID<b><span style = 'color: #990000;'><span style='padding-left:2px; padding-right: 2px;'>SafeCampus</span></span></b></p>"))
)),
titleWidth = "330px"
),
dashboardSidebar(
width = 320,
sidebarMenu(id = "tabs", collapsed = TRUE,
tags$head(
tags$style(HTML(".skin-black .sidebar-menu>li.active>a {font-weight: 700;}"))
),
menuItem("Map", tabName = "geographic", selected=TRUE, icon=icon("map-marked-alt")),
menuItem('Dashboard',tabName = "discrete", icon=icon("th-large")),
menuItem("Daily Summary", tabName = "continuous", icon=icon("clock")),
menuItem("Predictions", tabName = "predictions", icon=icon("chart-line")),
menuItem("About", tabName = "about", icon=icon("info-circle")),
menuItem("Feedback",href ="https://docs.google.com/forms/d/1H_W6vvoXqEPiNtcpMnjdHQhjrgqrS1_LR3v2X9chJhg/edit?usp=sharing", icon=icon("comment-dots")),
menuItem("Collapse Sidebar", icon = icon("align-justify" ), tabName="Collapser")
)
),
dashboardBody(
tabItem(tabName = "survey",
tags$style(HTML(".sidebar-menu a {color: #FF0000}"))
),
style = "background-color: #FAFAFA; height: 100%; min-height: 100vh;",
shinyjs::useShinyjs(),
tags$head(tags$link(includeScript("func.js"))),
tags$head(tags$style("a{cursor:pointer;}")),
tabItems(
#MAP TAB
tabItem(tabName="geographic", uiOutput("geographic_ctrl"),br(),
fluidRow(column(h4(uiOutput('title_map'), style = 'color: #d6001c'),width =12)),
tags$style("#title_panel {font-size:30px;color:black;display:block;}"),
tags$div(h5("Click on any bubble to view daily and weekly summaries for each building.")),
fluidRow(
column(8,
fluidRow(column(12, div(leafletOutput("bubblemap", height = 650))))),
column(4,
fluidRow(inputPanel(
radioButtons("datatype", "Choose to view Wi-Fi access by users or devices",
c("Users" = "user", "Devices" = "mac"),
selected="user"),
dateInput("day", label = 'Select a Date',
value = max(rpi_wap_raw$Date),
min = min(fall_dates),
max = max(rpi_wap_raw$Date)),
selectInput("semester", label = "Select a Semester",
choices = list("Fall 2020" = "f20", "Spring 2021" = "s21", "Summer 2021" = "su21"),
selected = "su21", multiple = FALSE, selectize = TRUE, width = NULL, size = NULL),
checkboxGroupInput("buildingtype", "Select a building type",
choices = c("Academic"="academic",
"Housing" = "housing",
"Greek" = "greek",
"Other Off Campus" = "otherOffCampus",
"Other On Campus" = "otherOnCampus"),
selected = list("academic", "housing", "greek", "otherOnCampus")),
radioButtons("size", "Select how you would like to view the size of the bubbles",
choices = c("Actual size" = "actual", "Same size" = "same"),
selected = "actual"),
tags$style(type = "text/css",
".irs-grid-text:nth-last-child(1) {opacity: 0}"),
div(style="margin-left:0px; width: 350px;",
sliderInput("time",
"Select a time range",
min = as_datetime(hms::parse_hm("0:00")),
max = as_datetime(hms::parse_hm("23:30")),
value = c(now_time-hours(2),now_time),
timeFormat = "%H:%M",
timezone = "GMT",
step = 30*60)))))),
shinyjs::hidden(
tags$div(id = "more_tabs",
fluidRow(column(h4(uiOutput('reactive_title'), style = 'color: #d6001c'),width =12)),
helpText(HTML("<a onclick=","customHref('discrete')" ,">",
"Click to see more about this building</a>")),
fluidRow(
tabsetPanel(type = "tabs",
tabPanel("Today", plotOutput("today_plot"), downloadButton("downloadDayPlot", "Download Graph")),
tabPanel("Weekly Overview", plotOutput("week_plot"), downloadButton("downloadWeekPlot", "Download Graph"))))
))),
#DASHBOARD TAB
tabItem(tabName="discrete", uiOutput("interval_ctrl"), br(),
fluidRow(column(h4(uiOutput('title_dashboard'), style = 'color: #d6001c'),width =12)),
tags$style("#title_panel {font-size:30px;color:black;display:block;}"),
helpText(HTML("<a onclick=","customHref('geographic')" ,">",
"Go to Map</a>")),
helpText(HTML("<a onclick=","customHref('continuous')" ,">",
"Go to Daily Summary</a>")),
helpText(HTML("<a onclick=","customHref('predictions')" ,">",
"Go to Predictions</a>")),
box(collapsible=TRUE, width = '100%', title = tags$div(HTML("<span style = 'color: #646160; '> Selection Inputs</span>")), style = 'color:#54585a; background-color: gray60', solidHeader=TRUE,
inputPanel(radioButtons("data_type_discrete",
"Choose to view Wi-Fi access by users or by devices",
c("Users" = "user", "Devices" = "mac"),
selected = "user"),
dateInput("date_discrete",
label = 'Select a Date',
value = max(rpi_wap_raw$Date),
min = min(fall_dates),
max = max(rpi_wap_raw$Date)),
selectInput("semester_discrete", label = "Select a Semester",
choices = list("Fall 2020" = "f20","Spring 2021" = "s21", "Summer 2021" = "su21"),
selected = "su21", multiple = FALSE, selectize = TRUE, width = NULL, size = NULL),
checkboxGroupInput("buildingType_discrete","Select a building type",
choices = c("Academic"="academic",
"Housing" = "housing",
"Greek" = "greek",
"Other Off Campus" = "otherOffCampus",
"Other On Campus" = "otherOnCampus"),
selected = list("academic")),
selectInput("buildingStr_discrete", "Select a building",
choices = list("All building of selected type"="all",
"Academic" = academic,"Housing" = housing,
"Greek" = greek,"Other Off Campus" = otherOffCampus,
"Other On Campus" = otherOnCampus),
selected = "all",multiple = FALSE,selectize = TRUE,width = NULL,size = NULL),
selectInput("floor_number", "Choose which floor to view",
choices = c("All Floors"= "NA","Basement" = "basement",
"First" = "1","Second" = "2","Third" = "3",
"Fourth" = "4","Fifth" = "5"),
selected = "NA",multiple = FALSE,selectize = TRUE, width = NULL,size = NULL),
tags$style(type = "text/css",
".irs-grid-text:nth-last-child(1) {opacity: 0}"),
div(style="margin-left:-150px; width: 350px;",
sliderInput("timeRange",
"Select a time range",
min = as_datetime(hms::parse_hm("0:00")),
max = as_datetime(hms::parse_hm("23:30")),
# value = c(as_datetime(hms::parse_hm("14:00:00")),
# as_datetime(hms::parse_hm("16:00:00"))),
value = c(now_time-hours(2),now_time),
timeFormat = "%H:%M",
timezone = "GMT",
step = 30*60)))),
fluidRow(column(9,br(),fluidRow(column(12, div(uiOutput("discrete_plot3", height = "100%")), downloadButton("downloadDiscreteplot3", "Download Graph"))),
br(),fluidRow(column(12, div(uiOutput("discrete_plot1", height = "100%")), downloadButton("downloadDiscreteplot1", "Download Graph")))),
column(3,br(),fluidRow(column(12, div(uiOutput("discrete_plot4", height = "100%")), downloadButton("downloadDiscreteplot4", "Download Graph"))),
br(),fluidRow(column(12, div(uiOutput("discrete_plot2", height = "100%")), downloadButton("downloadDiscreteplot2", "Download Graph")))))),
#DAILY SUMMARY TAB
tabItem(tabName="continuous", br(), br(),
fluidRow(column(h4(uiOutput('title_panel_cont'), style = 'color: #d6001c'), width =12)),
helpText(HTML("<a onclick=","customHref('geographic')" ,">",
"Go to Map</a>")),
helpText(HTML("<a onclick=","customHref('discrete')" ,">",
"Go to Dashboard</a>")),
helpText(HTML("<a onclick=","customHref('predictions')" ,">",
"Go to Predictions</a>")),
box(collapsible=TRUE, width = '100%', title = tags$div(HTML("<span style = 'color: #646160; '> Selection Inputs</span>")), style = 'color:#54585a; background-color: gray60', solidHeader=TRUE,
inputPanel(dateInput("date", label = 'Select a Date',
value = max(rpi_wap_raw$Date),
min = min(fall_dates),
max = max(rpi_wap_raw$Date)),
selectInput("semester_continuous", label = "Select a Semester",
choices = list("Fall 2020" = "f20",
"Spring 2021" = "s21",
"Summer 2021" = "su21"),
selected = "su21",
multiple = FALSE,
selectize = TRUE,
width = NULL,
size = NULL),
radioButtons("data_type_continous", "Choose to view Wi-Fi access by users or devices",
c("Users" = "user", "Devices" = "mac"),
selected = "user"),
checkboxGroupInput(
"buildingType",
"Select a builiding type",
choices = c("Academic"="academic",
"Housing" = "housing",
"Greek" = "greek",
"Other Off Campus" = "otherOffCampus",
"Other On Campus" = "otherOnCampus"),
selected = list("academic")),
selectInput("buildingStr",
"Select a building from above building type",
choices = list("Building from above building type"="all",
"Academic" = academic,
"Housing" = housing,
"Greek" = greek,
"Other Off Campus" = otherOffCampus,
"Other On Campus" = otherOnCampus),
selected = "all",
multiple = FALSE,
selectize = TRUE,
width = NULL,
size = NULL),
selectInput("threshold",
"Ignore the Max User(or Device) counts during a day below",
choices = list("0" = 0,"1" = 1,"2" = 2,"3" = 3,"4" = 4,"5" = 5,"6" = 6,"7" = 7,"8" = 8,"9" = 9,"10" = 10),
selected = 5)
)),
fluidRow(tags$style("#continous_table {margin-top:10px; margin-right:10px}"),
tags$style("#continuous_ui {margin-top:10px}"),
column(8,div(uiOutput("continuous_ui"), downloadButton('downloadContinuous', 'Download Graph'))),
column(3, div(DT::dataTableOutput("continous_table"), downloadButton('downloadContinuousTable', 'Download Table'))))),
#PREDICTION TAB
tabItem(tabName="predictions", uiOutput("predictions_ctrl"), br(), br(),
fluidRow(column(h4("WiFi Usage Predictions", style = 'color: #d6001c'), width =12)),
helpText(HTML("<a onclick=","customHref('geographic')" ,">",
"Go to Map</a>")),
helpText(HTML("<a onclick=","customHref('discrete')" ,">",
"Go to Dashboard</a>")),
helpText(HTML("<a onclick=","customHref('continuous')" ,">",
"Go to Daily Summary</a>")),
sidebarPanel(radioButtons("data_type_predictions",
"Choose to view Wi-Fi access by users or by devices",
c("Users" = "user", "Devices" = "mac"),
selected = "user"),
selectInput(
"weekday",
"Select a day of the week",
choices = list("Monday"="monday", "Tuesday"="tuesday", "Wednesday"="wednesday", "Thursday"="thursday",
"Friday"="friday", "Saturday" = "saturday", "Sunday" = "sunday"),
selected = "monday",
multiple = FALSE,
selectize = TRUE,
width = NULL,
size = NULL
),
selectInput("building_predictions",
"Select a building or a building type",
choices = list("Academic" = academic, "Housing" = housing, "Greek" = greek,
"Other Off Campus" = otherOffCampus, "Other On Campus" = otherOnCampus),
selected = c("amos", "carn", "biot"),
multiple = TRUE,
selectize = TRUE,
width = NULL,
size = NULL)),
mainPanel(plotlyOutput("prediction_plot"), )
),
#ABOUT TAB
tabItem(tabName = "about",
uiOutput("about_body"))
),
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" />\');
//all related pages should be linked below
$("header").find("nav").append(\'<p><div class="title-text title-rside"><span style = "font-size: 200%">COVID<b></span><span style = "color: #990000; padding-right: 5%; font-size:200%">SafeCampus</span></b></div>\');
// $(".sidebar-toggle").insertAfter(".tab-content");
})
')),
)
)
# Define server logic
server <- function(input, output, session) {
## COLLAPSING SIDEBAR
runjs({'
var el2 = document.querySelector(".skin-black");
el2.className = "skin-black sidebar-mini";
var clicker = document.querySelector(".sidebar-toggle");
clicker.id = "switchState";
'})
onclick('switchState', runjs({'
var title = document.querySelector(".logo")
if (title.style.visibility == "hidden") {
title.style.visibility = "visible";
} else {
title.style.visibility = "hidden";
}
'}))
# add id to body so we can grab in shinyjs::addClass
runjs("document.getElementsByTagName('body')[0].id = 'pagebody'")
# add id to collapser based on it's data value; the data value comes from the menuItem tabname
runjs(paste0('document.querySelectorAll("[data-value=', "'Collapser'", ']")[0].id = "collapser"'))
# overwrite data-toggle so that clicking on collapser doesn't un-select the tab that's currently selected
runjs(paste0('document.querySelectorAll("[data-value=', "'Collapser'", ']")[0].setAttribute("data-toggle", "")'))
# register onclick event with collapser to add class sidebar-collapse
onclick("collapser", shinyjs::addClass(id="pagebody", class = "sidebar-collapse"))
write_hm <- function(time){
format(as.POSIXct(time, format = "%Y-%m-%dT%H:%M:%S"), "%H:%M")
}
## CAMPUS WIFI OVERVIEW TAB
output$geographic_ctrl <- renderUI({
observeEvent(input$semester,{
req(input$semester, input$day)
semester_val <- semester_val(input$semester)
date_val <- date_val(input$day)
#are we going backwards in time?
if(semester_val < date_val){
if(input$semester == "f20"){
updateDateInput(session, "day", max = max(fall_dates), value = min(fall_dates),)
updateDateInput(session, "day", min = min(fall_dates))
}
else if(input$semester == "s21"){
updateDateInput(session, "day", max = max(spring_dates), value = min(spring_dates),)
updateDateInput(session, "day", min = min(spring_dates))
}
}
#are we going forwards in time?
else if (semester_val > date_val){
if(input$semester == "s21"){
updateDateInput(session, "day", max = max(spring_dates), value = max(spring_dates),)
updateDateInput(session, "day", min = min(spring_dates))
}
else if(input$semester == "su21"){
updateDateInput(session, "day", max = max(rpi_wap_raw$Date), value = max(rpi_wap_raw$Date),)
updateDateInput(session, "day", min = min(summer_dates))
}
}
else {
}
})
incoming <- reactive({
start_time <- hms::as_hms(input$time[1])
end_time <- hms::as_hms(input$time[2])
# Update other slider
updateSliderInput(session,"timeRange",value=c(input$time[1],input$time[2]))
if(input$semester=="f20"){
db <- dbConnect(MySQL(), dbname = "safecampus", user = "dataincite", password = "P4Z2w@d!", host = "sequel.idea.rpi.edu")
query_data <- dbGetQuery(db, paste0("SELECT * FROM rpi_wap_f20 WHERE Date='", as.Date(input$day),"'", " AND ", "time BETWEEN '", start_time, "'", " AND '", end_time, "'"))
dbDisconnect(db)
combined_wap_data_final <- query_data %>%
filter(buildingType %in% input$buildingtype) %>%
dplyr::group_by(Building, latitude, longitude, buildingType, abbrev, time) %>%
dplyr::summarize(usercount = sum(usercount), maccount = sum(maccount)) %>%
dplyr::group_by(Building, longitude, latitude, buildingType, abbrev) %>%
dplyr::summarize(max_users=max(usercount), average_users=mean(usercount), total_users=sum(usercount),
max_macs=max(maccount), average_macs=mean(maccount), total_macs=sum(maccount))
}
else if(input$semester=="s21"){
db <- dbConnect(MySQL(), dbname = "safecampus", user = "dataincite", password = "P4Z2w@d!", host = "sequel.idea.rpi.edu")
query_data <- dbGetQuery(db, paste0("SELECT * FROM rpi_wap_s21 WHERE Date='", as.Date(input$day),"'", " AND ", "time BETWEEN '", start_time, "'", " AND '", end_time, "'"))
dbDisconnect(db)
combined_wap_data_final <- query_data %>%
filter(buildingType %in% input$buildingtype) %>%
dplyr::group_by(Building, latitude, longitude, buildingType, abbrev, time) %>%
dplyr::summarize(usercount = sum(usercount), maccount = sum(maccount)) %>%
dplyr::group_by(Building, longitude, latitude, buildingType, abbrev) %>%
dplyr::summarize(max_users=max(usercount), average_users=mean(usercount), total_users=sum(usercount),
max_macs=max(maccount), average_macs=mean(maccount), total_macs=sum(maccount))
}
else if(input$semester=="su21"){
if(input$day %in% rpi_wap_raw$Date){
combined_wap_data_final <- rpi_wap_raw %>%
filter(Date==input$day, buildingType %in% input$buildingtype) %>%
filter(time>=start_time) %>%
filter(time<=end_time) %>%
dplyr::group_by(Building, latitude, longitude, buildingType, abbrev, time) %>%
dplyr::summarize(usercount = sum(usercount), maccount = sum(maccount)) %>%
dplyr::group_by(Building, latitude, longitude, buildingType, abbrev) %>%
dplyr::summarize(max_users=max(usercount), average_users=mean(usercount), total_users=sum(usercount),
max_macs=max(maccount), average_macs=mean(maccount), total_macs=sum(maccount))
}
else{
db <- dbConnect(MySQL(), dbname = "safecampus", user = "dataincite", password = "P4Z2w@d!", host = "sequel.idea.rpi.edu")
query_data <- dbGetQuery(db, paste0("SELECT * FROM rpi_wap_su21 WHERE Date='", as.Date(input$day),"'", " AND ", "time BETWEEN '", start_time, "'", " AND '", end_time, "'"))
dbDisconnect(db)
combined_wap_data_final <- query_data %>%
filter(buildingType %in% input$buildingtype) %>%
dplyr::group_by(Building, latitude, longitude, buildingType, abbrev, time) %>%
dplyr::summarize(usercount = sum(usercount), maccount = sum(maccount)) %>%
dplyr::group_by(Building, longitude, latitude, buildingType, abbrev) %>%
dplyr::summarize(max_users=max(usercount), average_users=mean(usercount), total_users=sum(usercount),
max_macs=max(maccount), average_macs=mean(maccount), total_macs=sum(maccount))
}
}
})
# default box
minLng = min(rpi_wap_raw$longitude)
minLat = min(rpi_wap_raw$latitude)
maxLng = max(rpi_wap_raw$longitude)
maxLat = max(rpi_wap_raw$latitude)
#plot the bubble map
#observe({
output$bubblemap <- renderLeaflet({
if (input$datatype == "user"){
if(input$size == "actual"){
radius <- incoming()$max_users/2
}
else{
radius <- 15
}
pal <- colorNumeric(palette, incoming()$max_users, reverse=TRUE)
m <- leaflet(incoming()) %>% addTiles() %>%
addLegend(pal = pal, values = ~max_users, group = "circles", position = "topleft", title="Maximum Number of Users")
# only add the data if there is data to be added
if (nrow(incoming()) > 0) {
pal <- colorNumeric(palette = palette, domain = incoming()$max_users, reverse = TRUE)
m <- addCircles(m, lat = ~latitude, lng = ~longitude, radius = radius,
color = ~pal(max_users), stroke = FALSE, fillOpacity = .7, options = list(padding = c(50,50)))
m <- addCircleMarkers(m, lat = ~latitude, lng = ~longitude, popup = ~paste0("Building: ", Building, "<br>", "Max: ", max_users," users", "<br>", "Average: ", as.integer(average_users), " users", "<br>",
"Total: ", total_users, " users", "<br>", "Learn more about the ", "<a onclick=","customHref('","discrete","')>", Building,"</a>"),
options = popupOptions(closeButton = TRUE), radius = radius, color = ~pal(max_users))
} else {
m <- fitBounds(m, lng1 = minLng, lat1 = minLat, lng2 = maxLng, lat2 = maxLat)
}
}
else{
if(input$size == "actual"){
radius <- incoming()$max_macs/2
}
else{
radius <- 15
}
pal <- colorNumeric(palette, incoming()$max_macs, reverse=TRUE)
m <- leaflet(incoming()) %>% addTiles() %>%
addLegend(pal = pal, values = ~max_macs, group = "circles",
position = "topleft", title="Maximum Number of Users")
# only add the data if there is data to be added
if (nrow(incoming()) > 0) {
pal <- colorNumeric(palette = palette, domain = incoming()$max_macs, reverse = TRUE)
m <- addCircles(m, lat = ~latitude, lng = ~longitude, radius = radius,
color = ~pal(max_macs), stroke = FALSE, fillOpacity = .7, options = list(padding = c(50,50)))
m <- addCircleMarkers(m, lat = ~latitude, lng = ~longitude, popup = ~paste0("Building: ", Building, "<br>", "Max: ", max_macs," devices", "<br>", "Average: ", as.double(average_macs), " devices", "<br>",
"Total: ", total_macs, " macs", "<br>", "Learn more about the ", "<a onclick=","customHref('","discrete","')>", Building,"</a>"),
options = popupOptions(closeButton = TRUE), radius = radius, color = ~pal(max_macs))
} else {
m <- fitBounds(m, lng1 = minLng, lat1 = minLat, lng2 = maxLng, lat2 = maxLat)
}
}
})
## title for map
output$title_map <- renderUI({
if(length(input$buildingtype)==1){
paste("RPI on", format(input$day, "%A %B %d, %Y"), "from",
format(input$time[1], "%I:%M %p"), "to", format(input$time[2], "%I:%M %p"), "EST")
}
else{
paste("RPI on", format(input$day, "%A %B %d, %Y"), "from",
format(input$time[1], "%I:%M %p"), "to", format(input$time[2], "%I:%M %p"), "EST")
}
})
#data for day at a glance
day_dat <- reactive({
marker_info <- input$bubblemap_marker_click
abbreviation <- buildinginfo$abbrev[buildinginfo$latitude == marker_info$lat & buildinginfo$longitude == marker_info$lng]
if(input$semester=="f20"){
db <- dbConnect(MySQL(), dbname = "safecampus", user = "dataincite", password = "P4Z2w@d!", host = "sequel.idea.rpi.edu")
query_data <- dbGetQuery(db, paste0("SELECT * FROM rpi_wap_f20 WHERE Date= '", input$day, "'"))
dbDisconnect(db)
daily_data <-query_data %>% filter(abbrev == abbreviation)
}
else if(input$semester=="s21"){
db <- dbConnect(MySQL(), dbname = "safecampus", user = "dataincite", password = "P4Z2w@d!", host = "sequel.idea.rpi.edu")
query_data <- dbGetQuery(db, paste0("SELECT * FROM rpi_wap_s21 WHERE Date= '", input$day, "'"))
dbDisconnect(db)
daily_data <-query_data %>% filter(abbrev == abbreviation)
}
else if(input$semester == "su21"){
if(input$day %in% rpi_wap_raw$Date){
daily_data <-rpi_wap_raw %>%
filter(Date == input$day)%>%
filter(abbrev == abbreviation)
}
else{
db <- dbConnect(MySQL(), dbname = "safecampus", user = "dataincite", password = "P4Z2w@d!", host = "sequel.idea.rpi.edu")
query_data <- dbGetQuery(db, paste0("SELECT * FROM rpi_wap_su21 WHERE Date= '", input$day, "'"))
dbDisconnect(db)
daily_data <-query_data %>% filter(abbrev == abbreviation)
}
}
daily_data$time <- hms::as_hms(daily_data$time)
if (input$datatype == "user") {
trimmedHitsData <- daily_data %>%
dplyr::group_by(time) %>%
dplyr::summarize(total = sum(usercount))
} else {
trimmedHitsData <- daily_data %>%
dplyr::group_by(time) %>%
dplyr::summarize(total = sum(maccount))
}
})
ht <- reactiveVal(400)
ht_main <- reactiveVal(400)
set_breaks = function(max_y) {
if (max_y <= 4){
seq(0, max_y, by = 1)
} else if (max_y > 4 & max_y < 16){
seq(0, max_y, by = 2)
} else {
seq(0, max_y, by = max_y %/% 4)
}
}
#data for week at a glace
week_dat <- reactive({
marker_info <- input$bubblemap_marker_click
abbreviation <- buildinginfo$abbrev[buildinginfo$latitude == marker_info$lat & buildinginfo$longitude == marker_info$lng]
if(input$semester=="f20"){
start_date <- as.Date(input$day)
end_date <- start_date+days(7)
db <- dbConnect(MySQL(), dbname = "safecampus", user = "dataincite", password = "P4Z2w@d!", host = "sequel.idea.rpi.edu")
query_data <- dbGetQuery(db, paste0("SELECT * FROM rpi_wap_f20 WHERE Date BETWEEN '", start_date, "'", " AND '", end_date, "'"))
dbDisconnect(db)
if(input$datatype == "user"){
week_data <- query_data %>% filter(abbrev == abbreviation) %>%
dplyr::group_by(Date)%>%
dplyr::summarize(day_sum = sum(usercount))
}
else{
week_data <- query_data %>% filter(abbrev == abbreviation) %>%
dplyr::group_by(Date)%>%
dplyr::summarize(day_sum = sum(maccount))
}
}
else if(input$semester=="s21"){
start_date <- as.Date(input$day)
end_date <- start_date+days(7)
db <- dbConnect(MySQL(), dbname = "safecampus", user = "dataincite", password = "P4Z2w@d!", host = "sequel.idea.rpi.edu")
query_data <- dbGetQuery(db, paste0("SELECT * FROM rpi_wap_s21 WHERE Date BETWEEN '", start_date, "'", " AND '", end_date, "'"))
dbDisconnect(db)
if(input$datatype == "user"){
week_data <- query_data %>% filter(abbrev == abbreviation) %>%
dplyr::group_by(Date)%>%
dplyr::summarize(day_sum = sum(usercount))
}
else{
week_data <- query_data %>% filter(abbrev == abbreviation) %>%
dplyr::group_by(Date)%>%
dplyr::summarize(day_sum = sum(maccount))
}
}
else if(input$semester == "su21"){
if(input$day %in% rpi_wap_raw$Date){
if(input$datatype == "user"){
week_data <- rpi_wap_raw %>% filter(abbrev == abbreviation) %>%
dplyr::group_by(Date)%>%
dplyr::summarize(day_sum = sum(usercount))
}
else{
week_data <- rpi_wap_raw %>% filter(abbrev == abbreviation) %>%
dplyr::group_by(Date)%>%
dplyr::summarize(day_sum = sum(maccount))
}
}
else{
start_date <- as.Date(input$day)
end_date <- start_date+days(7)
db <- dbConnect(MySQL(), dbname = "safecampus", user = "dataincite", password = "P4Z2w@d!", host = "sequel.idea.rpi.edu")
query_data <- dbGetQuery(db, paste0("SELECT * FROM rpi_wap_su21 WHERE Date BETWEEN '", start_date, "'", " AND '", end_date, "'"))
dbDisconnect(db)
if(input$datatype == "user"){
week_data <- query_data %>% filter(abbrev == abbreviation) %>%
dplyr::group_by(Date)%>%
dplyr::summarize(day_sum = sum(usercount))
}
else{
week_data <- query_data %>% filter(abbrev == abbreviation) %>%
dplyr::group_by(Date)%>%
dplyr::summarize(day_sum = sum(maccount))
}
}
}
})
#function to print day plot
print_day_plot <- function(){
max_y <- max(day_dat()$total)
marker_info <- input$bubblemap_marker_click
abbreviation <- buildinginfo$abbrev[buildinginfo$latitude == marker_info$lat & buildinginfo$longitude == marker_info$lng]
names <- buildinginfo %>% filter(abbrev == abbreviation)
fullname <- names$Building
gg.title <- paste("WiFi Access in 30 Minutes Intervals on", format(input$day, "%A %B %d, %Y"), "in", fullname)
ggplot(day_dat(), aes(x=write_hm(time), y=total, fill=total)) +
geom_bar(stat="identity") +
xlab(label = "Time of Day (24-Hour Clock)") +
ylab(label = "Wifi Access by Hour") +
ggtitle(gg.title) +
theme_bw() +
scale_fill_distiller(palette = "Purples", direction = "horizontal", name = "total",
breaks = set_breaks(max_y)) +
theme_ipsum() +
theme(plot.title = element_text(size = 16)) +
theme(axis.title.x = element_text(size = 12)) +
theme(axis.title.y = element_text(size = 12)) +
theme(axis.text.x = element_text(angle = 60))+
theme(plot.margin = unit(c(1,0,1,2.5), "cm")) +
theme(panel.grid.major.x = element_line(colour = "black"),
panel.ontop = TRUE) +
theme(legend.key.size = unit(0.3, "cm"))
}
#function to print week plot
print_week_plot <- function(){
marker_info <- input$bubblemap_marker_click
abbreviation <- buildinginfo$abbrev[buildinginfo$latitude == marker_info$lat & buildinginfo$longitude == marker_info$lng]
names <- buildinginfo %>% filter(abbrev == abbreviation)
fullname <- unique(names$Building)
gg.title <- paste("WiFi Access in Daily Intervals From", min(week_dat()$Date), "to", max(week_dat()$Date), "in", fullname)
max_y <- max(week_dat()$day_sum)
ggplot(week_dat(), aes(x=Date, y=day_sum, fill=day_sum)) +
geom_bar(stat="identity") +
xlab(label = "Day of the Week") +
ylab(label = "Total WiFi Access") +
ggtitle(gg.title)+
theme_bw() +
scale_fill_distiller(palette = "Purples", direction = "horizontal", name = "total",
breaks = set_breaks(max_y)) +
theme_ipsum() +
theme(plot.title = element_text(size = 16)) +
theme(axis.title.x = element_text(size = 12)) +
theme(axis.title.y = element_text(size = 12)) +
theme(plot.margin = unit(c(1,0,1,2.5), "cm")) +
theme(panel.grid.major.x = element_line(colour = "black"),
panel.ontop = TRUE)
}
observeEvent(input$bubblemap_marker_click, {
shinyjs::showElement(id= "more_tabs")
if(!is.null(input$bubblemap_marker_click)){
output$reactive_title <- renderText({
marker_info <- input$bubblemap_marker_click
buildingname <- buildinginfo$Building[buildinginfo$latitude == marker_info$lat & buildinginfo$longitude == marker_info$lng]
paste(buildingname," at a glance")
})
#today's plot
observe({
output$today_plot <- renderPlot({
print_day_plot()
}, height=ht_main)
})
output$downloadDayPlot <- downloadHandler(
filename = "DayPlot.png",
content = function(file) {
png(file)
print(print_day_plot())
dev.off()},
contentType = 'image/png'
)
#past week plot
observe({
output$week_plot <- renderPlot({
print_week_plot()
})
})
output$downloadWeekPlot <- downloadHandler(
filename = "WeekPlot.png",
content = function(file) {
png(file)
print(print_week_plot())
dev.off()},
contentType = 'image/png'
)
}
})
})
## CAMPUS WIFI DASHBOARD TAB
output$interval_ctrl <- renderUI({
observeEvent(input$semester_discrete,{
req(input$semester_discrete, input$date_discrete)
semester_val <- semester_val(input$semester_discrete)
date_val <- date_val(input$date_discrete)
#are we going backwards in time?
if(semester_val < date_val){
if(input$semester_discrete == "f20"){
updateDateInput(session, "date_discrete", max = max(fall_dates), value = min(fall_dates),)
updateDateInput(session, "date_discrete", min = min(fall_dates))
}
else if(input$semester_discrete == "s21"){
updateDateInput(session, "date_discrete", max = max(spring_dates), value = min(spring_dates),)
updateDateInput(session, "date_discrete", min = min(spring_dates))
}
}
#are we going forwards in time?
else if (semester_val > date_val){
if(input$semester_discrete == "s21"){
updateDateInput(session, "day", max = max(spring_dates), value = max(spring_dates),)
updateDateInput(session, "day", min = min(spring_dates))
}
else if(input$semester_discrete == "su21"){
updateDateInput(session, "date_discrete", max = max(rpi_wap_raw$Date), value = max(rpi_wap_raw$Date),)
updateDateInput(session, "date_discrete", min = min(summer_dates))
}
}
else {
}
})
wap_dat <- reactive({
if(input$semester_discrete == "f20"){
db <- dbConnect(MySQL(), dbname = "safecampus", user = "dataincite", password = "P4Z2w@d!", host = "sequel.idea.rpi.edu")
query_data <- dbGetQuery(db, paste0("SELECT * FROM rpi_wap_f20 WHERE Date= '", input$date_discrete, "'"))
dbDisconnect(db)
}
else if(input$semester_discrete == "s21"){
db <- dbConnect(MySQL(), dbname = "safecampus", user = "dataincite", password = "P4Z2w@d!", host = "sequel.idea.rpi.edu")
query_data <- dbGetQuery(db, paste0("SELECT * FROM rpi_wap_s21 WHERE Date= '", input$date_discrete, "'"))
dbDisconnect(db)
}
else if(input$semester_discrete == "su21"){
if(input$date_discrete %in% rpi_wap_raw$Date){
query_data <- rpi_wap_raw
}
else{
db <- dbConnect(MySQL(), dbname = "safecampus", user = "dataincite", password = "P4Z2w@d!", host = "sequel.idea.rpi.edu")
query_data <- dbGetQuery(db, paste0("SELECT * FROM rpi_wap_su21 WHERE Date= '", input$date_discrete, "'"))
dbDisconnect(db)
}
}
query_data$time <- hms::as_hms(query_data$time)
query_data
})
discrete_dat <- reactive({
if (input$floor_number == "NA"){
if(input$buildingStr_discrete=="all"){
building=""
# if user does not select any building type, the plot should show all the Wap data.
if(is.null(input$buildingType_discrete)){
discrete_data <- wap_dat()
}
# if user select one or more building types, the plot should show the data of the buildings in those types.
else{
discrete_data <- wap_dat() %>%
filter(buildingType%in%input$buildingType_discrete) %>%
filter(time>=(hms::as_hms(input$timeRange[1]))) %>%
filter(time<=(hms::as_hms(input$timeRange[2])))
}
}
# when the user selects a specified building.
else{
discrete_data <- wap_dat() %>%
filter(abbrev == input$buildingStr_discrete)%>%
filter(time>=(hms::as_hms(input$timeRange[1]))) %>%
filter(time<=(hms::as_hms(input$timeRange[2])))
}
}
else{
floor <- input$floor_number
if(input$buildingStr_discrete=="all"){
building=""
# if user does not select any building type, the plot should show all the Wap data.
if(is.null(input$buildingType_discrete)){
discrete_data <- wap_dat() %>%
filter(Floor == floor)
}
# if user select one or more building types, the plot should show the data of the buildings in those types.
else{
discrete_data <- wap_dat() %>%
filter(buildingType%in%input$buildingType_discrete) %>%
filter(time>=(hms::as_hms(input$timeRange[1]))) %>%
filter(time<=(hms::as_hms(input$timeRange[2]))) %>%
filter(Floor == floor)
}
}
# when the user selects a specified building.
else{
discrete_data <- wap_dat() %>%
filter(abbrev == input$buildingStr_discrete)%>%
filter(time>=(hms::as_hms(input$timeRange[1]))) %>%
filter(time<=(hms::as_hms(input$timeRange[2]))) %>%
filter(Floor == floor)
}
}
discrete_data
})
# Sum the number of Wi-Fi users by device
by_device <- reactive({
if (input$data_type_discrete == "user") {
trimmedHitsData <- discrete_dat() %>%
dplyr::group_by(devname, Date) %>%
dplyr::summarize(total = sum(usercount))
trimmedHitsData$time <- hms::as_hms(trimmedHitsData$time)
} else {
trimmedHitsData <- discrete_dat() %>%
dplyr::group_by(devname, Date) %>%
dplyr::summarize(total = sum(maccount))
trimmedHitsData$time <- hms::as_hms(trimmedHitsData$time)
}
trimmedHitsData
})
# Sum the number of Wi-Fi users by hour
by_time <- reactive({
if (input$data_type_discrete == "user") {
trimmedHitsData <- discrete_dat() %>%
dplyr::group_by(time) %>%
dplyr::summarize(total = sum(usercount))
trimmedHitsData$time <- hms::as_hms(trimmedHitsData$time)
} else {
trimmedHitsData <- discrete_dat() %>%
dplyr::group_by(time) %>%
dplyr::summarize(total = sum(maccount))
trimmedHitsData$time <- hms::as_hms(trimmedHitsData$time)
}
trimmedHitsData
})
discrete_dat_fin <- reactive({
if (input$data_type_discrete == "user") {
all_discrete_dat <- discrete_dat() %>%
dplyr::group_by(time, devname) %>%
dplyr::summarize(Count = sum(usercount))
all_discrete_dat$time <- hms::as_hms(all_discrete_dat$time)
} else {
all_discrete_dat <- discrete_dat() %>%
dplyr::group_by(time, devname) %>%
dplyr::summarize(Count = sum(maccount))
all_discrete_dat$time <- hms::as_hms(all_discrete_dat$time)
}
all_discrete_dat
})
ht <- reactiveVal(400)
ht_main <- reactiveVal(400)
set_breaks = function(max_y) {
if (max_y <= 4){
seq(0, max_y, by = 1)
} else if (max_y > 4 & max_y < 16){
seq(0, max_y, by = 2)
} else {
seq(0, max_y, by = max_y %/% 4)
}
}
# Plot the graphs for the interval view
observe({
print_discrete_plot1 <- function(){
max_y <- max(discrete_dat_fin()$Count)
names <- buildinginfo %>% filter(abbrev == input$buildingStr_discrete)
fullname <- unique(names$Building)
ggplot(discrete_dat_fin(), aes(x = write_hm(time), y = devname, fill = Count)) +
geom_tile() +
xlab(label = "Time of Day (24-Hour Clock)") +
ylab(label = "WAP Device Name") +
ggtitle(paste("WiFi Access per WAP Device in 30 Minute Intervals on", input$date_discrete, "in",
fullname, "from", format(input$timeRange[1], "%H:%M"), "to", format(input$timeRange[2], "%H:%M"))) +
scale_fill_distiller(palette = "Purples", direction = "horizontal", name = "Count",
breaks = set_breaks(max_y)) +
theme_ipsum() +
theme(plot.title = element_text(size = 12)) +
theme(axis.title.x = element_text(size = rel(.8))) +
theme(axis.title.y = element_text(size = rel(.8))) +
theme(axis.text.x = element_text(angle = 60))+
theme(plot.margin = unit(c(1,0,1,0), "cm")) +
theme(panel.grid.major.x = element_line(colour = "black"),
panel.ontop = TRUE) +
theme(legend.key.size = unit(0.3, "cm"))
}
observe({
output$p1 <- renderPlot({
print_discrete_plot1()
}, height=ht_main)
output$discrete_plot1 <- renderUI({
if(nrow(discrete_dat())==0){
h1(" ")
}
else{
plotOutput("p1",height = "100%")
}
})
})
output$downloadDiscreteplot1 <- downloadHandler(
filename = "DiscretePlot1.png",
content = function(file) {
png(file)
print(print_discrete_plot1())
dev.off()},
contentType = 'image/png'
)
print_discrete_plot2 <- function(){
max_y <- max(by_device()$total)
names <- buildinginfo %>% filter(abbrev == input$buildingStr_discrete)
fullname <- unique(names$Building)
ggplot(by_device(), aes(x=devname, y=total, fill=total)) +
geom_bar(stat="identity") +
xlab(label = "WAP Device Name") +
ylab(label = "Total Access Per WAP Device") +
ggtitle(paste("WiFi Access per WAP Device on \n", input$date_discrete, "in",
fullname, "from \n", format(input$timeRange[1], "%H:%M"), "to", format(input$timeRange[2], "%H:%M"))) +
scale_fill_distiller(palette = "Purples", direction = "horizontal", name = "Count", breaks = set_breaks(max_y)) + theme_ipsum() +
theme_bw() + coord_flip() +
theme(plot.title = element_text(size = 10, face = "bold")) +
theme(axis.title.x = element_text(size = rel(.8))) +
theme(axis.title.y = element_text(size = rel(.8))) +
theme(plot.margin = unit(c(1,0,1,0), "cm")) +
theme(legend.key.size = unit(0.3, "cm"))
}
observe({
output$p2 <- renderPlot({
print_discrete_plot2()
}, height=ht_main)
output$discrete_plot2 <- renderUI({
if(nrow(discrete_dat())==0){
h1(" ")
}
else{
plotOutput("p2",height = "100%")
}
})
})
output$downloadDiscreteplot2 <- downloadHandler(
filename = "DiscretePlot2.png",
content = function(file) {
png(file)
print(print_discrete_plot2())
dev.off()},
contentType = 'image/png'
)
print_discrete_plot3 <- function(){
max_y <- max(by_time()$total)
names <- buildinginfo %>% filter(abbrev == input$buildingStr_discrete)
fullname <- unique(names$Building)
ggplot(by_time(), aes(x=write_hm(time), y=total, fill=total)) +
geom_bar(stat="identity") +
xlab(label = "Time of Day (24-Hour c=Clock)") +
ylab(label = "Number of WAP Device Access by Hour") +
ggtitle(paste("WiFi Access in 30 Minute Intervals on", input$date_discrete, "in",
fullname, "from", format(input$timeRange[1], "%H:%M"), "to", format(input$timeRange[2], "%H:%M"))) +
theme_bw() +
scale_fill_distiller(palette = "Purples", direction = "horizontal", name = "Count",
breaks = set_breaks(max_y)) +
theme_ipsum() +
theme(plot.title = element_text(size = 12)) +
theme(axis.title.x = element_text(size = rel(.8))) +
theme(axis.title.y = element_text(size = rel(.8))) +
theme(axis.text.x = element_text(angle = 60))+
theme(plot.margin = unit(c(1,0,1,2.5), "cm")) +
theme(panel.grid.major.x = element_line(colour = "black"),
panel.ontop = TRUE) +
theme(legend.key.size = unit(0.3, "cm"))
}
observe({
output$p3 <- renderPlot({
print_discrete_plot3()
}, height=ht)
output$discrete_plot3 <- renderUI({
if(nrow(discrete_dat())==0){
h1(" ")
}
else{
plotOutput("p3",height = "100%")
}
})
})
output$downloadDiscreteplot3 <- downloadHandler(
filename = "DiscretePlot3.png",
content = function(file) {
png(file)
print(print_discrete_plot3())
dev.off()},
contentType = 'image/png'
)
print_discrete_cont_plot <- function(){
max_y <- max(by_time()$total)
names <- buildinginfo %>% filter(abbrev == input$buildingStr_discrete)
fullname <- unique(names$Building)
ggplot(by_time(), aes(x=write_hm(time), y = total)) +
geom_line(data = by_time(), aes(x=hms::as_hms(time), y=total), color = "#999999", size = 2) +
geom_point(data = by_time(), aes(fill=total), colour="black",pch=21, size=2) +
xlab(label = "Time of Day (24-Hour Clock)") +
ylab(label = "Total Access by Hour") +
ggtitle(paste("Continuous Representation of WiFi Access on \n", input$date_discrete, "in",
fullname)) +
theme_bw() +
scale_colour_distiller(palette = "Purples", trans = "reverse") +
scale_fill_distiller(palette = "Purples", direction = "horizontal", name = "Count",
breaks = set_breaks(max_y)) +
theme_ipsum() +
theme(plot.title = element_text(size = 10)) +
theme(axis.title.x = element_text(size = rel(.8))) +
theme(axis.title.y = element_text(size = rel(.8))) +
theme(axis.text.x = element_text(angle = 60))+
theme(plot.margin = unit(c(1,0,1,0), "cm")) +
theme(legend.key.size = unit(0.3, "cm"))
}
observe({
output$p4 <- renderPlot({
print_discrete_cont_plot()
}, height=ht)
output$discrete_plot4 <- renderUI({
if(nrow(discrete_dat())==0){
h1(" ")
}
else{
plotOutput("p4",height = "100%")
}
})
})
output$downloadDiscreteplot4 <- downloadHandler(
filename = "DiscretePlot4.png",
content = function(file) {
png(file)
print(print_discrete_cont_plot())
dev.off()},
contentType = 'image/png'
)
## title for dashboard
output$title_dashboard <- renderUI({
start_time <- format(input$timeRange[1], "%I:%M %p")
end_time <- format(input$timeRange[2], "%I:%M %p")
# Update other slider
updateSliderInput(session,"time",value=c(input$timeRange[1],input$timeRange[2]))
if(input$floor_number == "NA"){
if(input$buildingStr_discrete=="all"){
if(length(input$buildingType_discrete)==1){
paste("All Buildings of", tools::toTitleCase(input$buildingType_discrete), "Type on", format(input$date_discrete, "%A %B %d, %Y"), "from",
start_time, "to", end_time, "EST")
}
else{
building_type=stri_replace_last(toString(input$buildingType_discrete), fixed = ",", " and")
paste("All Buildings of", tools::toTitleCase(building_type), "Type on", format(input$date_discrete, "%A %B %d, %Y"), "from",
start_time, "to", end_time, "EST")
}
} else{
row<- which(buildinginfo$abbrev == input$buildingStr_discrete)
buildingname<-buildinginfo[row, 1]
paste(buildingname, "on", format(input$date_discrete, "%A %B %d, %Y"), "from", start_time, "to", end_time, "EST")
}
}
else if(input$floor_number == "basement"){
if(input$buildingStr_discrete=="all"){
if(length(input$buildingType_discrete)==1){
paste("Basements in All Buildings of", tools::toTitleCase(input$buildingType_discrete), "Type on", format(input$date_discrete, "%A %B %d, %Y"), "from",
start_time, "to", end_time, "EST")
}
else{
bulding_type=stri_replace_last(toString(input$buildingType_discrete), fixed = ",", " and")
paste("Basements in All Buildings of", tools::toTitleCase(building_type), "Type on", format(input$date_discrete, "%A %B %d, %Y"), "from",
start_time, "to", end_time, "EST")
}
} else{
row<- which(buildinginfo$abbrev == input$buildingStr_discrete)
buildingname<-buildinginfo[row, 1]
paste("Basement of ", buildingname, "on", format(input$date_discrete, "%A %B %d, %Y"), "from", start_time, "to", end_time, "EST")
}
}
else{
floor_names <- list("1" = "First", "2" = "Second", "3" = "Third", "4" = "Fourth", "5" = "Fifth")
floor_name <- as.character(floor_names[input$floor_number])
if(input$buildingStr_discrete=="all"){
if(length(input$buildingType_discrete)==1){
paste(floor_name, "Floor of All Buildings of ", tools::toTitleCase(input$buildingType_discrete), "Type on", format(input$date_discrete, "%A %B %d, %Y"), "from",
start_time, "to", end_time, "EST")
}
else{
bulding_type=stri_replace_last(toString(input$buildingType_discrete), fixed = ",", " and")
paste(floor_name, "Floor of All Buildings of ", tools::toTitleCase(building_type), "Type on", format(input$date_discrete, "%A %B %d, %Y"), "from",
start_time, "to", end_time, "EST")
}
} else{
row<- which(buildinginfo$abbrev == input$buildingStr_discrete)
buildingname<-buildinginfo[row, 1]
paste(floor_name, "Floor of ", buildingname, "on", format(input$date_discrete, "%A %B %d, %Y"), "from", start_time, "to", end_time, "EST")
}
}
})
})
if (input$floor_number == "NA"){
observeEvent({
input$buildingStr_discrete
input$date_discrete
input$buildingType_discrete
input$timeRange}, {
if(nrow(discrete_dat_fin())!=0){
row_number<-length(unique(discrete_dat_fin()$devname))
if(row_number==1){
ht_main(row_number*75)
} else if(row_number>1 & row_number<=3){
ht_main(row_number*65)
}else if(row_number>3 & row_number<=5){
ht_main(row_number*55)
} else if (row_number>5 & row_number<=10){
ht_main(row_number*50)
} else if (row_number>10 & row_number<=15){
ht_main(row_number*40)
} else if (row_number>15 & row_number<=20){
ht_main(row_number*30)
} else {
ht_main(row_number*25)
}
}
})
}
else{
observeEvent({
input$buildingStr_discrete
input$date_discrete
input$buildingType_discrete
input$timeRange
input$floor_number}, {
if(nrow(discrete_dat_fin())!=0){
row_number<-length(unique(discrete_dat_fin()$devname))
if(row_number==1){
ht_main(row_number*75)
} else if(row_number>1 & row_number<=3){
ht_main(row_number*65)
}else if(row_number>3 & row_number<=5){
ht_main(row_number*55)
} else if (row_number>5 & row_number<=10){
ht_main(row_number*50)
} else if (row_number>10 & row_number<=15){
ht_main(row_number*40)
} else if (row_number>15 & row_number<=20){
ht_main(row_number*30)
} else {
ht_main(row_number*25)
}
}
})
}
})
# update input choices with only showing the buildings for the selected building types
observe({
# If users do not select any building type, plot should show all the data;
# The dropdown should include all the buildings.
if(!is.null(input$buildingType)){
buildingtype<-input$buildingType
buildingname<-alltype[buildingtype]
buildingname<-c("Buildings from above building type(s)"="all",buildingname)
}
else{
buildingname<-c("Buildings from above building type(s)"="all",alltype)
}
updateSelectInput(session, "buildingStr",
choices = buildingname
)
})
#switching between semesters
observeEvent(input$semester_continuous,{
req(input$semester_continuous, input$date)
semester_val <- semester_val(input$semester_continuous)
date_val <- date_val(input$date)
#are we going backwards in time?
if(semester_val < date_val){
if(input$semester_continuous == "f20"){
updateDateInput(session, "date_discrete", max = max(fall_dates), value = min(fall_dates),)
updateDateInput(session, "date_discrete", min = min(fall_dates))
}
else if(input$semester_continuous == "s21"){
updateDateInput(session, "date", max = max(spring_dates), value = min(spring_dates),)
updateDateInput(session, "date", min = min(spring_dates))
}
}
#are we going forwards in time?
else if (semester_val > date_val){
if(input$semester_continuous == "s21"){
updateDateInput(session, "day", max = max(spring_dates), value = max(spring_dates),)
updateDateInput(session, "day", min = min(spring_dates))
}
else if(input$semester_continuous == "su21"){
updateDateInput(session, "date", max = max(rpi_wap_raw$Date), value = max(rpi_wap_raw$Date),)
updateDateInput(session, "date", min = min(summer_dates))
}
}
else {
}
})
output$title_panel_cont = renderUI({
if(input$buildingStr=="all"){
if(length(input$buildingType)==1){
paste("All building of", tools::toTitleCase(input$buildingType), "type on", format(input$date, "%A %B %d, %Y"))
}
# if the user selects multiple building types
else{
building_type=stri_replace_last(toString(input$buildingType_discrete), fixed = ",", " and")
paste("All building of", tools::toTitleCase(building_type), "type on", format(input$date, "%A %B %d, %Y"))
}
} else{
row<- which(buildinginfo$abbrev == input$buildingStr)
buildingname<-buildinginfo[row, 1]
paste(buildingname, "on", format(input$date, "%A %B %d, %Y"))
}
})
cont_wap_dat <- reactive({
if(input$semester_continuous == "f20"){
db <- dbConnect(MySQL(), dbname = "safecampus", user = "dataincite", password = "P4Z2w@d!", host = "sequel.idea.rpi.edu")
query_data <- dbGetQuery(db, paste0("SELECT * FROM rpi_wap_f20 WHERE Date= '", input$date, "'"))
dbDisconnect(db)
}
else if(input$semester_continuous == "s21"){
db <- dbConnect(MySQL(), dbname = "safecampus", user = "dataincite", password = "P4Z2w@d!", host = "sequel.idea.rpi.edu")
query_data <- dbGetQuery(db, paste0("SELECT * FROM rpi_wap_s21 WHERE Date= '", input$date, "'"))
dbDisconnect(db)
}
else if(input$semester_continuous == "su21"){
if(input$date %in% rpi_wap_raw$Date){
query_data <- rpi_wap_raw
}
else{
db <- dbConnect(MySQL(), dbname = "safecampus", user = "dataincite", password = "P4Z2w@d!", host = "sequel.idea.rpi.edu")
query_data <- dbGetQuery(db, paste0("SELECT * FROM rpi_wap_su21 WHERE Date= '", input$date, "'"))
dbDisconnect(db)
}
}
query_data$time <- hms::as_hms(query_data$time)
query_data
})
dat <- reactive({
if(input$data_type_continous=="user"){
# when the user selects the 'entire campus'
if(input$buildingStr=="all"){
building=""
# if user does not select any building type, the plot should show all the Wap data.
if(is.null(input$buildingType)){
rpi_wap_raw<-cont_wap_dat() %>%
# Filter by selected date and building
filter(Date==as_date(input$date))%>%
group_by(devname) %>%
mutate(max_count = max(usercount)) %>%
ungroup() %>%
filter(max_count>=input$threshold)
}
# if user select one or more building types, the plot should show the data of the buildings in those types.
else{
rpi_wap_raw<- cont_wap_dat() %>%
# Filter by selected date and building
filter(Date==as_date(input$date))%>%
filter(buildingType%in% input$buildingType)%>%
group_by(devname) %>%
mutate(max_count = max(usercount)) %>%
ungroup() %>%
filter(max_count>=input$threshold)
}
}
# when the user selects a specified building.
else{
rpi_wap_raw<-cont_wap_dat() %>%
# Filter by selected date, building types, and building
filter(Date==as_date(input$date)) %>%
filter(abbrev == input$buildingStr)%>%
group_by(devname) %>%
mutate(max_count = max(usercount)) %>%
ungroup() %>%
filter(max_count>=input$threshold)
}
}
else {
# when the user selects the 'entire campus'
if(input$buildingStr=="all"){
building=""
# if user does not select any building type, the plot should show all the Wap data.
if(is.null(input$buildingType)){
rpi_wap_raw<-cont_wap_dat() %>%
# Filter by selected date and building
filter(Date==as_date(input$date))%>%
group_by(devname) %>%
mutate(max_count = max(maccount)) %>%
ungroup() %>%
filter(max_count>=input$threshold)
}
# if user select one or more building types, the plot should show the data of the buildings in those types.
else{
rpi_wap_raw<-cont_wap_dat() %>%
# Filter by selected date and building
filter(Date==as_date(input$date))%>%
filter(buildingType %in% input$buildingType)%>%
group_by(devname) %>%
mutate(max_count = max(maccount)) %>%
ungroup() %>%
filter(max_count>=input$threshold)
}
}
# when the user selects a specified building.
else{
rpi_wap_raw<-cont_wap_dat() %>%
# Filter by selected date, building types, and building
filter(Date==as_date(input$date)) %>%
filter(abbrev == input$buildingStr)%>%
group_by(devname) %>%
mutate(max_count = max(maccount)) %>%
ungroup() %>%
filter(max_count>=input$threshold)
}
}
})
plotHeight <- reactiveVal(1000)
print_continuous_plot <- function(){
#if there is data under selected condition.
if(nrow(dat())!=0){
if(input$data_type_continous=="user"){
dat() %>%
ggplot( aes(x=as.POSIXct(date_time), y=0.5)) +
geom_line(aes(color = usercount, size=2)) +
scale_color_gradient(low = "white", high = "darkblue") +
ylim(0,1) +
theme_bw() +
theme(axis.text.y=element_blank(),
axis.ticks.y=element_blank(),
panel.grid.major.y = element_blank(),
panel.grid.minor.y = element_blank()) +
facet_grid(rows = vars(devname), switch = "both") +
theme(panel.border = element_rect(color = "white", fill = NA, size = 1))+
theme(strip.text.y.left = element_text(angle = 0)) +
theme(panel.grid.minor.x = element_line( size=0.5, color="black" ),
panel.grid.major.x = element_line( size=1, color="black" )) +
scale_x_datetime(date_breaks = "3 hours",date_minor_breaks="1 hour",position="top", date_labels="%H") +
theme(legend.position="right") +
theme(text = element_text(size = 20))+
theme(
panel.background = element_rect(fill = NA),
panel.ontop = TRUE)+
labs(y="Access Point ID", x = "Time of Day(24hr clock)")
}
else {
dat() %>%
ggplot( aes(x=as.POSIXct(date_time), y=0.5)) +
geom_line(aes(color = maccount, size=2)) +
scale_color_gradient(low = "white", high = "darkblue") +
ylim(0,1) +
theme_bw() +
theme(axis.text.y=element_blank(),
axis.ticks.y=element_blank(),
panel.grid.major.y = element_blank(),
panel.grid.minor.y = element_blank()) +
facet_grid(rows = vars(devname), switch = "both") +
theme(panel.border = element_rect(color = "white", fill = NA, size = 1))+
theme(strip.text.y.left = element_text(angle = 0)) +
theme(panel.grid.minor.x = element_line( size=0.5, color="black" ),
panel.grid.major.x = element_line( size=1, color="black" )) +
scale_x_datetime(date_breaks = "3 hours",date_minor_breaks="1 hour",position="top", date_labels="%H") +
theme(legend.position="right") +
theme(text = element_text(size = 20))+
theme(panel.background = element_rect(fill = NA), panel.ontop = TRUE)+
labs(y="Access Point ID", x = "Time of Day(24hr clock)")
}
}
}
observe({
output$plot2 <- renderPlot({
print_continuous_plot()
},height = plotHeight)
output$continuous_ui<- renderUI({
# if there is no data under selected condition.
if(nrow(dat())==0){
h1("There is no building under selected condition")
}
else{
plotOutput("plot2",height = "100%")
}
})
})
output$downloadContinuous <- downloadHandler(
filename = "DailyOverview.png",
content = function(file) {
png(file)
print(print_continuous_plot())
dev.off()},
contentType = 'image/png'
)
print_continuous_table <- function(){
names <- buildinginfo %>% filter(abbrev == input$buildingStr)
fullname <- unique(names$Building)
if(input$buildingStr!="all"&input$data_type_continous=="user"){
building_user<-paste("Total Number of Users in", fullname)
type_user<-paste("Total Number of Users in", tools::toTitleCase(input$buildingType), "Type")
max_building_user<-paste("Max Number of Users in", fullname)
max_type_user<-paste("Max Number of Users in", tools::toTitleCase(input$buildingType), "Type")
max_count<-dat()[!duplicated(dat()$devname),]
hottest_time<-dat()[dat()$usercount==dat()$max_count,]
hottest_time<-format(as.POSIXct(hottest_time[!duplicated(hottest_time$devname),]$date_time), "%H:%M")
cont_table<-data.frame("Devname"=(max_count$devname),"max_building_user"=(max_count$max_count),"Hottest Time"=hottest_time)
names(cont_table)[names(cont_table) == "max_building_user"]=max_building_user
rownames(cont_table) <- NULL
colnames(cont_table) <- c("WAP Name", "Maximum Number of Users", "Peak Time")
cont_table
}
else if(input$buildingStr!="all"&input$data_type_continous=="macs"){
building_macs<-paste("Total Number of Devicess in", fullname)
type_macs<-paste("Total Number of Devices in", tools::toTitleCase(input$buildingType), "Type")
max_building_macs<-paste("Max Number of Devices in", fullname)
max_type_macs<-paste("Max Number of Devices in", tools::toTitleCase(input$buildingType), "Type")
max_count<-dat()[!duplicated(dat()$devname),]
hottest_time<-dat()[dat()$maccount==dat()$max_count,]
hottest_time<-format(hottest_time[!duplicated(hottest_time$devname),]$date_time, "%H:%M")
cont_table<-data.frame("Devname"=(max_count$devname),"max_building_macs"=(max_count$max_count),"Hottest Time"=hottest_time)
names(cont_table)[names(cont_table) == "max_building_macs"]=max_building_macs
rownames(cont_table) <- NULL
colnames(cont_table) <- c("WAP Name", "Maximum Number of Devices", "Peak Time")
cont_table
}
}
observe({
output$continous_table <- DT::renderDataTable({
print_continuous_table()
},options = list(searching = FALSE))
})
output$downloadContinuousTable <- downloadHandler(
filename = "PeakTimeTable.png",
content = function(file) {
png(file)
print(print_continuous_table())
dev.off()},
contentType = 'image/png'
)
observeEvent({
input$buildingStr
input$threshold
input$date
input$buildingType}, {
if(nrow(dat())!=0){
row_number<-length(unique(dat()$devname))
if (row_number > 10000) {
plotHeight(10000)
} else if(row_number==1){
plotHeight(row_number*75)
} else if(row_number>1 & row_number<=3){
plotHeight(row_number*65)
}else if(row_number>3 & row_number<=10){
plotHeight(row_number*40)
} else if (row_number>10 & row_number<=20){
plotHeight(row_number*30)
} else {
plotHeight(row_number*25)
}
}
})
## PREDICTIONS TAB
output$predictions_ctrl <- renderUI({
p_dat <- reactive({
if(length(input$building_predictions) > 2){
buildings <- paste("(", str_replace_all(str_replace_all(knitr::combine_words(input$building_predictions, before="'", after="'",sep=','), "and", '')," ",""), ")", sep="")
}
else if(length(input$building_predictions)==2){
buildings <- paste("(", str_replace_all(str_replace_all(knitr::combine_words(input$building_predictions, before="'", after="'",sep=','), "and", ",")," ",""), ")", sep="")
}
else if(length(input$building_predictions)==1){
buildings <- paste("(",input$building_predictions,")")
}
db <- dbConnect(MySQL(), dbname = "safecampus", user = "dataincite", password = "P4Z2w@d!", host = "sequel.idea.rpi.edu")
query_data <- dbGetQuery(db, paste0("SELECT * FROM ", input$weekday," WHERE abbrev IN ", buildings, ""))
dbDisconnect(db)
combined_wap_data_final <- query_data %>%
dplyr::group_by(Building, latitude, longitude, buildingType, abbrev, time) %>%
dplyr::summarize(usercount = sum(usercount), maccount = sum(maccount)) %>%
dplyr::group_by(Building, longitude, latitude, buildingType, abbrev, time) %>%
dplyr::summarize(max_users=max(usercount), average_users=mean(usercount), total_users=sum(usercount),
max_macs=max(maccount), average_macs=mean(maccount), total_macs=sum(maccount))
combined_wap_data_final
})
output$prediction_plot <- renderPlotly({
if(input$data_type_predictions == "user"){
plot_ly(p_dat(), x = ~time, y = ~max_users, color = ~Building, colors = palette) %>%
add_lines() %>%
layout(xaxis = list(title = "Time of Day (24-Hour Clock)"),
yaxis = list(title = "Maximum User Count in Intervals"))
}
else{
plot_ly(p_dat(), x = ~time, y = ~max_macs, color = ~Building, colors = palette) %>%
add_lines() %>%
layout(xaxis = list(title = "Time of Day (24-Hour Clock)"),
yaxis = list(title = "Maximum Mac Count in Intervals"))
}
})
})
## ABOUT TAB
output$about_body <- renderUI({
tags$div(
HTML("
<h1>About COVID<b><span style = 'color: #990000;'>SafeCampus</span></b></h1>
<div style='margin-left: 5%'>
<p>COVID Safe Campus reveals WiFi access point usage and aggregations of wireless users on the campus network at Rensselaer Polytechnic Institute, Troy, New York.</p>
</div>
<hr>
<h4>Map</h4>
<li>This tab reveals the usage of Wi-Fi access points on the campus network at RPI. </li>
<li>Users can customize their searches using the following 4 selections: </li>
<ol>
<li>View the WiFi access via user count or device count. </li>
<li>Select a specific date within the last seven days. </li>
<li>Refine their searches by only selecting specific building types. </li>
<li>Specify a specific time range in 30 minute intervals. </li>
<li>Select to view the bubbles where their size reflects the exact number of maximum users/devices or their sizes are all the same so that the bubbles are only differentiated by color. </ol>
<li>Based on the user's selection, the main panel will display a bubble map. </li>
<ul>
<li>The color of each bubble represents whether there is a high or low maximum number of users at that specific building during the given time interval.</li>
<li>The diameter of each bubble represents the maximum number of users at that specific building during the given time interval. </li>
<li>The user can click on each bubble to view the building name, maximum number of users, and average number of users during the given time interval. </li>
<li>Once a bubble is clicked, 2 bar plots will appear below the map, so the user may look at the daily and weekly WiFi usage in the selected building at a glance. </li></ul>
<p></p>
<h4>Dashboard</h4>
<li>This tab provides an overview of the WiFi access on campus via WAP devices in 30 minute intervals. </li>
<li>Users can customize their searches using the following six selections: </li>
<ol>
<li>View the WiFi access via user count or device count. </li>
<li>Select a specific date within the last seven days. </li>
<li>Refine their searches by only selecting from specific building types. </li>
<li>Select a specific or multiple buildings. </li>
<li>Select a specific floor. </li>
<li>Specify a specific time range in 30 minute intervals.</li> </ol>
<li>Based on user's selection, the main panel will display the following four plots:
<ol>
<li>A main heatmap displaying the WiFi access per WAP device at every 30 minutes interval.</li>
<li>Two aggregate bar plots showing the WiFi access per WAP device and every 30 minutes.</li>
<li>A plot of the WiFi access at each 30 minute interval modeled by a polynomial function. </li></ol>
<h4>Daily Summary</h4>
<li>This tab provides an overview of the WiFi access on campus via WAP devices. </li>
<li>Users can customize their searches using the following five selections: </li>
<ol>
<li>View the WiFi access via user count or device count. </li>
<li>Select a specific date within the last 7 days. </li>
<li>Refine their searches by only selecting from specific building types. </li>
<li>Select a specific or multiple buildings. </li>
<li>Select a threshold to ignore maximum user or device counts if they are below that level.</li> </ol>
<li>Based on the user's selection, the main panel will display a heatmap showcasing the WiFi access per WAP device. </li>
<p></p>
<h4>Predictions</h4>
<li>This tab uses historical data to predict WiFi access on campus via WAP devices on future days of the week. </li>
<li>Users can customize their searches using the following three selections: </li>
<ol>
<li>View the WiFi access via user count or device count. </li>
<li>Select a specific date in the future. </li>
<li>Select one or more buildings to compare. </li></ol>
<li>Based on the user's selection the main panel will display a plotly line graph where the user can compare WiFi access between selected buildings. </li>
</div>
<hr>
<h4>DISCLAIMERS</h4>
<p>This is a prototype app. Some of the information displayed may not be 100% accurate. Improvements to this app will continue to be made. </p> "),
)
})
# CONSISTENT INPUTS ACROSS ALL TABS
observe({
# MAP TAB
if(input$tabs=='geographic'){
marker_info <- input$bubblemap_marker_click
abbreviation <- buildinginfo$abbrev[buildinginfo$latitude == marker_info$lat & buildinginfo$longitude == marker_info$lng]
# SWITCHING TO DAILY SUMMARY
if((!(input$buildingStr == abbreviation)||!(input$date == input$day)||!(input$buildingType == input$buildingtype)||!(input$data_type_continous == input$datatype)) &&
!is.null(input$bubblemap_marker_click)||!(input$semester_continuous == input$semester)){
updateRadioButtons(session, "data_type", selected=input$datatype)
updateDateInput(session, "date", value = input$day)
updateCheckboxGroupInput(session, "buildingType", selected = input$buildingtype)
updateSelectInput(session, "semester_continuous", selected = input$semester)
# If users do not select any building type, plot should show all buildings
if(!is.null(input$buildingType)){
buildingtype<-input$buildingType
buildingname<-alltype[buildingtype]
buildingname<-c("Buildings from selected building type(s)"="all",buildingname)
}
else{
buildingname<-c("Buildings from selected building type(s)"="all",alltype)
}
updateSelectInput(session, "buildingStr",choices = buildingname,selected=abbreviation)
}
# SWITCHING TO DASHBOARD
if((!(input$buildingStr_discrete == abbreviation)||!(input$semester_discrete == input$semester)||!(input$date_discrete == input$day)||!(input$timeRange == input$time)||!
(identical(input$buildingType_discrete, input$buildingtype))||!(identical(input$data_type_discrete,input$datatype))) && !is.null(input$bubblemap_marker_click)){
updateRadioButtons(session, "data_type_discrete", selected=input$datatype)
updateDateInput(session, "date_discrete", value = input$day)
updateCheckboxGroupInput(session, "buildingType_discrete", selected = input$buildingtype)
updateSelectInput(session, "semester_discrete", selected = input$semester)
updateSliderInput(session, "timeRange", value=input$time, timeFormat = "%H:%M")
# If users do not select any building type, plot should show all buildings
if(!is.null(input$buildingType_discrete)){
buildingtype<-input$buildingType_discrete
buildingname<-alltype[buildingtype]
buildingname<-c("Buildings from selected building type(s)"="all",buildingname)
}
else{
buildingname<-c("Buildings from selected building type(s)"="all",alltype)
}
updateSelectInput(session, "buildingStr_discrete",choices = buildingname,selected=abbreviation)
}
}
# DAILY SUMMARY TAB
else if(input$tabs=='continuous'){
data_type_info <- input$data_type_continous
date_info<-input$date
building_type_info<-input$buildingType
building_info<-input$buildingStr
semester_info <- input$semester_continuous
# SWITCHING TO MAP
if(!(input$datatype == data_type_info)||!(input$day == date_info)||!(identical(input$buildingtype,building_type_info))){
updateRadioButtons(session, "datatype", selected=data_type_info)
updateDateInput(session, "day", value = date_info)
updateCheckboxGroupInput(session, "buildingtype", selected = building_type_info)
}
# SWITCHING TO DASHBOARD
if(!(input$data_type_discrete == data_type_info)||!(input$date_discrete == date_info)||!(identical(input$buildingType_discrete,building_type_info))||!(input$buildingStr_discrete==building_info)){
updateRadioButtons(session, "data_type__discrete", selected=data_type_info)
updateDateInput(session, "date_discrete", value = date_info)
updateCheckboxGroupInput(session, "buildingType_discrete", selected = building_type_info)
# If users do not select any building type, plot should show all buildings
if(!is.null(input$buildingType_discrete)){
buildingtype<-input$buildingType_discrete
buildingname<-alltype[buildingtype]
buildingname<-c("Buildings from selected building type(s)"="all",buildingname)
}
else{
buildingname<-c("Buildings from selected building type(s)"="all",alltype)
}
updateSelectInput(session, "buildingStr_discrete",choices = buildingname,selected=building_info)
}
}
# CAMPUS WIFI DASHBOARD
else if(input$tabs=='discrete'){
data_type_info <- input$data_type_discrete
date_info<-input$date_discrete
building_type_info<-input$buildingType_discrete
building_info<-input$buildingStr_discrete
time_info<-input$timeRange
# SWITCHING TO MAP
if(!(input$datatype == data_type_info)||!(input$day == date_info)||!(identical(input$buildingtype,building_type_info))||!(identical(input$time, time_info))){
updateRadioButtons(session, "datatype", selected=data_type_info)
updateDateInput(session, "day", value = date_info)
updateCheckboxGroupInput(session, "buildingtype", selected = building_type_info)
updateSliderInput(session, "time", value=time_info, timeFormat = "%H:%M")
}
# SWITCHING TO DAILY SUMMARY
if(!(input$data_type_continous == data_type_info)||!(input$date == date_info)||!(identical(input$buildingType,building_type_info))||!(input$buildingStr==building_info)){
updateRadioButtons(session, "data_type_continous", selected=data_type_info)
updateDateInput(session, "date", value = date_info)
updateCheckboxGroupInput(session, "buildingType", selected = building_type_info)
if(!is.null(input$buildingType)){
buildingtype<-input$buildingType
buildingname<-alltype[buildingtype]
buildingname<-c("Buildings from selected building type(s)"="all",buildingname)
}
else{
buildingname<-c("Buildings from selected building type(s)"="all",alltype)
}
updateSelectInput(session, "buildingStr",choices = buildingname,selected=building_info)
}
}
})
}
# Run the application
shinyApp(ui = ui, server = server)