Permalink
Cannot retrieve contributors at this time
Name already in use
A tag already exists with the provided branch name. Many Git commands accept both tag and branch names, so creating this branch may cause unexpected behavior. Are you sure you want to create this branch?
IDEA-COVID-SafeCampus/app.R
Go to fileThis commit does not belong to any branch on this repository, and may belong to a fork outside of the repository.
executable file
1366 lines (1301 sloc)
73.8 KB
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
| # Data Incite 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") | |
| 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(shinyalert) | |
| #loading R script | |
| source("building_info.R", chdir = TRUE) | |
| # rpi_wap_raw <- readRDS("/academics/MATP-4910-F20/COVID_RPI_WiFi_Data/rpi_wap_raw.rds") | |
| 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") | |
| 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("Campus WiFi Overview", tabName = "geographic", selected=TRUE), | |
| menuItem('Campus WiFi Dashboard',tabName = "discrete"), | |
| menuItem("Detailed WiFi Overview", tabName = "continuous"), | |
| menuItem("Daily Overview", tabName = "week"), | |
| menuItem("About COVIDSafeCampus", tabName = "about"), | |
| menuItem("Comments and questions?",href ="https://docs.google.com/forms/d/1H_W6vvoXqEPiNtcpMnjdHQhjrgqrS1_LR3v2X9chJhg/edit?usp=sharing") | |
| ) | |
| ), | |
| 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( | |
| #about tab | |
| tabItem(tabName = "about", | |
| uiOutput("about_body")), | |
| #weekly overview tab | |
| tabItem(tabName = "week", | |
| uiOutput("week_ctrl"), br(), br(), | |
| tags$div(HTML("<h4>Daily Summary of Wi-Fi Access Point Usage</h4>")), | |
| helpText(HTML("<a onclick=","customHref('geographic')" ,">", | |
| "Go to campus map view</a>")), | |
| helpText(HTML("<a onclick=","customHref('discrete')" ,">", | |
| "Go to Campus WiFi Dashboard</a>")), | |
| helpText(HTML("<a onclick=","customHref('continuous')" ,">", | |
| "Go to Detailed WiFi Overview</a>")), | |
| wellPanel(inputPanel(radioButtons("data_type_week", "Choose to view Wi-Fi access by users or by devices", | |
| c("Users" = "user", "Devices" = "mac"), | |
| selected = "user"), | |
| checkboxGroupInput( | |
| "buildingType_week", | |
| "Select a building type", | |
| choices = c("Academic"="academic", | |
| "Housing" = "housing", | |
| "Greek" = "greek", | |
| "Other Off Campus" = "otherOffCampus", | |
| "Other On Campus" = "otherOnCampus"), | |
| selected = list("academic") | |
| ), | |
| dateRangeInput("daterange", "Date range: ", | |
| start = min(rpi_wap_raw$Date), | |
| end = min(rpi_wap_raw$Date) + 6, | |
| min = min(rpi_wap_raw$Date), | |
| max = max(rpi_wap_raw$Date), | |
| format = "mm/dd/yy", | |
| separator = " - "), | |
| selectInput( | |
| "buildingStr_week", | |
| "Select a building", | |
| choices = list("Academic" = academic, | |
| "Housing" = housing, | |
| "Greek" = greek, | |
| "Other Off Campus" = otherOffCampus, | |
| "Other On Campus" = otherOnCampus), | |
| selected = "all", | |
| multiple = FALSE, | |
| selectize = TRUE, | |
| width = NULL, | |
| size = NULL | |
| )), | |
| plotOutput("barplot", width = "100%", height = 700))), | |
| #campus dashboard tab | |
| tabItem(tabName="discrete", uiOutput("interval_ctrl"), br(), br(),tags$div(HTML("<h4>Campus Wi-Fi Dashboard</h4>")), | |
| tags$style("#title_panel {font-size:30px;color:black;display:block;}"), | |
| fluidRow(column(12,br(), div(style="text-align:center", box(width=18, title = uiOutput("title_panel"))))), | |
| helpText(HTML("<a onclick=","customHref('geographic')" ,">", | |
| "Return to map</a>")), | |
| helpText(HTML("<a onclick=","customHref('continuous')" ,">", | |
| "Go to Detailed WiFi Overview</a>")), | |
| helpText(HTML("<a onclick=","customHref('week')" ,">", | |
| "Go to Week Overview</a>")), | |
| wellPanel(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 = 'Choose a date', | |
| value = max(rpi_wap_raw$Date), | |
| min = min(rpi_wap_raw$Date), | |
| max = max(rpi_wap_raw$Date) | |
| ), | |
| 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 | |
| ), | |
| radioButtons("floor_number", "Choose which floor(s) to view", | |
| c("Unspecified"= "NA", | |
| "Basement" = "basement", | |
| "First" = "1", | |
| "Second" = "2", | |
| "Third" = "3", | |
| "Fourth" = "4", | |
| "Fifth" = "5"), | |
| selected = "NA"), | |
| 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"))), | |
| timeFormat = "%H:%M", | |
| timezone = "GMT", | |
| step = 30*60)) | |
| ), | |
| fluidRow( | |
| column(9, | |
| br(), | |
| fluidRow(column(12, div(uiOutput("discrete_plot3", height = "100%")))), | |
| br(), | |
| fluidRow(column(12, div(uiOutput("discrete_plot1", height = "100%"))))), | |
| column(3, | |
| br(), | |
| fluidRow(column(12, div(uiOutput("cont_plot", height = "100%")))), | |
| br(), | |
| fluidRow(column(12, div(uiOutput("discrete_plot2", height = "100%"))))) | |
| ))), | |
| #campus wifi overview tab | |
| tabItem(tabName="geographic", uiOutput("geographic_ctrl"), br(), br(), tags$div(HTML("<h4>Wi-Fi Access Point Usage across Campus</h4> | |
| <p>The color of each bubble represents whether there is a high or low maximum number of users or devices relative to the other buildings on campus.<br/> | |
| The diameter of each bubble represents the maximum number of users or devices during the specified time period.<br/> | |
| The user can click on each bubble to view the building name, the maximum number of users or devices, and the average number of users or devices. </br> | |
| If you would like to differentiate the bubbles for each building only by color, select the same size option.</p>")), | |
| wellPanel(inputPanel(radioButtons("datatype", "Choose to view Wi-Fi access by users or devices", | |
| c("Users" = "user", "Devices" = "mac"), selected="user"), | |
| dateInput('day', label = 'Choose a day', value = sort(unique(rpi_wap_raw$Date))[length(unique(rpi_wap_raw$Date))-1], | |
| min = min(rpi_wap_raw$Date), max = max(rpi_wap_raw$Date)), | |
| 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")), | |
| div(style="width: 350px;", | |
| sliderInput("time", "Select a time period", | |
| 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"))), | |
| timeFormat = "%H:%M", | |
| timezone = "GMT", | |
| step = 30*60)), | |
| div(style="margin-left:200px; width: 200px;", | |
| radioButtons("size", "Select how you would like to view the size of the bubbles", | |
| choices = c("Actual size" = "actual", "Same size" = "same"), | |
| selected = "actual"))), | |
| leafletOutput("bubblemap", width = "100%", height = 700)) | |
| ), | |
| #continuous tab | |
| tabItem(tabName="continuous", | |
| tags$style("#title_panel_cont {font-size:30px;color:black;display:block;}"), | |
| fluidRow( | |
| column(12,br(), br(), br(), div(style="text-align:center", box(width=18, title = uiOutput("title_panel_cont")))) | |
| ), | |
| helpText(HTML("<a onclick=","customHref('geographic')" ,">", | |
| "Return to campus map view</a>")), | |
| helpText( HTML("<a onclick=","customHref('discrete')" ,">", | |
| "Go to Campus WiFi Dashboard</a>")), | |
| helpText(HTML("<a onclick=","customHref('week')" ,">", | |
| "Go to Week Overview</a>")), | |
| wellPanel(inputPanel(dateInput('date', | |
| label = 'Choose a date', | |
| value = sort(unique(rpi_wap_raw$Date))[length(unique(rpi_wap_raw$Date))-1], | |
| min = min(rpi_wap_raw$Date), | |
| max = max(rpi_wap_raw$Date) | |
| ), | |
| radioButtons("data_type_continous", "Choose to view Wi-Fi access by USERS or by 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"))), | |
| column(3, div(DT::dataTableOutput("continous_table")))) | |
| ) | |
| ), | |
| 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) { | |
| 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>Campus WiFi Overview</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 7 days. </li> | |
| <li>Specify the 30 minutes interval they wish to view. </li> | |
| <li>Refine their searches by only selecting specific building types. </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> </ul> | |
| <p></p> | |
| <h4>Continuous Data Overview </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 4 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>Select a specific or multiple buildings. </li> | |
| <li>Refine their searches by only selecting from specific building types. </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>Campus WiFi 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 5 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>Select a specific or multiple buildings. </li> | |
| <li>Refine their searches by only selecting from specific building types. </li> | |
| <li>Specify the 30 minutes interval they wish to view the information. </li> </ol> | |
| <li>Based on user's selection, the main panel will display 4 plots showcasing a main heatmap displaying the WiFi access per WAP device at every 30 minutes interval, 2 aggregate bar plots showing the WiFi access per WAP device and every 30 minutes, and a plot of the WiFi access at each 30 minutes interval modeled by a polynomial function. </li> | |
| <h4>Week Overview </h4> | |
| <li>This tab provides an overview of the WiFi access on campus via WAP devices over a specified date range.</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>Refine their searches by only selecting from specific building types. </li> | |
| <li>Select a specific date range to plot. </li> | |
| <li>Select a specific building. </li></ol> | |
| <li>Based on the user's selection the main panel will display a bar plot showcasing WiFi usage for a specific building over the input date range. </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> | |
| "), | |
| ) | |
| }) | |
| #Map tab | |
| output$geographic_ctrl <- renderUI({ | |
| incoming <- reactive({ | |
| combined_wap_data$Building <- forcats::fct_explicit_na(combined_wap_data$Building) | |
| wap_map_data_time1 <- combined_wap_data %>% filter(time==(hms::as_hms(input$time[1])), Date==input$day, buildingType %in% input$buildingtype) | |
| wap_map_data_time2 <- combined_wap_data %>% filter(time==(hms::as_hms(input$time[2])), Date==input$day, buildingType %in% input$buildingtype) | |
| combined_wap_data_with_times <- left_join(wap_map_data_time1, wap_map_data_time2, by=c("Building","Date", "latitude","longitude")) | |
| if (input$datatype == "user"){ | |
| users <- combined_wap_data_with_times %>% select(Building, users.x, users.y) | |
| users$max <- apply(users[,2:3],1,max) | |
| combined_wap_data_final <- combined_wap_data_with_times %>% mutate(average_users = (users.x+users.y)/2, time = time.y-time.x) | |
| combined_wap_data_final$max_users <- users$max | |
| combined_wap_data_final <- combined_wap_data_final %>% select(-time.x, -time.y, -users.x, -users.y) | |
| } | |
| else{ | |
| macs <- combined_wap_data_with_times %>% select(Building, macs.x, macs.y) | |
| macs$max <- apply(macs[,2:3],1,max) | |
| combined_wap_data_final <- combined_wap_data_with_times %>% mutate(average_macs = (macs.x+macs.y)/2, time = time.y-time.x) | |
| combined_wap_data_final$max_macs <- macs$max | |
| combined_wap_data_final <- combined_wap_data_final %>% select(-time.x, -time.y, -macs.x, -macs.y) | |
| } | |
| }) | |
| # 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({ | |
| if (input$size == "actual"){ | |
| output$bubblemap <- renderLeaflet({ | |
| if (input$datatype == "user"){ | |
| 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 = ~max_users/2, | |
| 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: ", average_users, " users", "<br>", | |
| "Learn more about the ", "<a onclick=","customHref('","discrete","')>", Building,"</a>"), | |
| options = popupOptions(closeButton = TRUE), radius = ~max_users/2, color = ~pal(max_users)) | |
| m | |
| } else { | |
| m <- fitBounds(m, lng1 = minLng, lat1 = minLat, lng2 = maxLng, lat2 = maxLat) | |
| m | |
| } | |
| } | |
| else{ | |
| 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 = ~max_macs/2, | |
| 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: ", average_macs, " devices", "<br>", | |
| "Learn more about the ", "<a onclick=","customHref('","discrete","')>", Building,"</a>"), | |
| options = popupOptions(closeButton = TRUE), radius = ~max_macs/2, color = ~pal(max_macs)) | |
| m | |
| } else { | |
| m <- fitBounds(m, lng1 = minLng, lat1 = minLat, lng2 = maxLng, lat2 = maxLat) | |
| m | |
| } | |
| } | |
| m | |
| }) | |
| } | |
| else{ | |
| output$bubblemap <- renderLeaflet({ | |
| if (input$datatype == "user"){ | |
| 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 = 15, | |
| 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: ", average_users, " users", "<br>", | |
| "Learn more about the ", "<a onclick=","customHref('","discrete","')>", Building,"</a>"), | |
| options = popupOptions(closeButton = TRUE), radius = 15, color = ~pal(max_users)) | |
| m | |
| } else { | |
| m <- fitBounds(m, lng1 = minLng, lat1 = minLat, lng2 = maxLng, lat2 = maxLat) | |
| m | |
| } | |
| } | |
| else{ | |
| 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 = 15, | |
| 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: ", average_macs, " devices", "<br>", | |
| "Learn more about the ", "<a onclick=","customHref('","discrete","')>", Building,"</a>"), | |
| options = popupOptions(closeButton = TRUE), radius = 15, color = ~pal(max_macs)) | |
| m | |
| } else { | |
| m <- fitBounds(m, lng1 = minLng, lat1 = minLat, lng2 = maxLng, lat2 = maxLat) | |
| m | |
| } | |
| } | |
| }) | |
| } | |
| #}) | |
| }) | |
| # keep input selector in all the tabs consistently, allow user to change the input in any tab. | |
| observe({ | |
| # when the users change input at the Campus Overview tab | |
| if(input$tabs=='geographic'){ | |
| marker_info <- input$bubblemap_marker_click | |
| abbreviation <- buildinginfo$abbrev[buildinginfo$latitude == marker_info$lat & buildinginfo$longitude == marker_info$lng] | |
| # If user was jumping to Detailed WiFi overview tab, then input date, time should be same as map's, and marker should be clicked | |
| if((!(input$buildingStr == abbreviation)||!(input$date == input$day)||!(input$buildingType == input$buildingtype)||!(input$data_type_continous == input$datatype)) && | |
| !is.null(input$bubblemap_marker_click)){ | |
| updateRadioButtons(session, "data_type", selected=input$datatype) | |
| updateDateInput(session, "date", value = input$day) | |
| updateCheckboxGroupInput(session, "buildingType", selected = input$buildingtype) | |
| # 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 selected building type(s)"="all",buildingname) | |
| } | |
| else{ | |
| buildingname<-c("Buildings from selected building type(s)"="all",alltype) | |
| } | |
| updateSelectInput(session, "buildingStr",choices = buildingname,selected=abbreviation) | |
| } | |
| # If user was jumping to WiFi dashboard, then input date, time should be same as map's, and marker should be clicked | |
| if((!(input$buildingStr_discrete == abbreviation)||!(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) | |
| updateSliderInput(session, "timeRange", value=input$time, timeFormat = "%H:%M") | |
| # 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_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) | |
| } | |
| # If user was jumping to Daily Overview, then input date, time should be same as map's, and marker should be clicked | |
| if((!(input$buildingStr_week == abbreviation)||!(identical(input$buildingType_week, input$buildingtype))||!(identical(input$data_type_week,input$datatype))) && | |
| !is.null(input$bubblemap_marker_click)){ | |
| updateRadioButtons(session, "data_type_week", selected=input$datatype) | |
| updateCheckboxGroupInput(session, "buildingType_week", selected = input$buildingtype) | |
| # 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_week)){ | |
| buildingtype<-input$buildingType_week | |
| 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_week",choices = buildingname,selected=abbreviation) | |
| } | |
| } | |
| # when the users change input at the Detailed Wifi Overview 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 | |
| # update the input in the Campus Wifi Overview tab consistently with the Detailed Wifi Overview tab | |
| 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) | |
| } | |
| # update the input in the Campus Wifi Dashboard tab consistently with the Detailed Wifi Overview tab | |
| 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 the data; | |
| # The dropdown should include all the 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) | |
| } | |
| # update the input in the Daily Overview tab consistently with the Detailed Wifi Overview tab | |
| if(!(input$data_type_week == data_type_info)||!(identical(input$buildingType_week,building_type_info))||!(input$buildingStr_week==building_info)){ | |
| updateRadioButtons(session, "data_type__week", selected=data_type_info) | |
| updateCheckboxGroupInput(session, "buildingType_week", selected = building_type_info) | |
| # 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_week)){ | |
| buildingtype<-input$buildingType_week | |
| 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_week",choices = buildingname,selected=building_info) | |
| } | |
| } | |
| # when the users change input at the Campus Wifi Dashboard tab | |
| 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 | |
| # update the input in the Campus Wifi Overview tab consistently with the Campus Wifi Dashboard tab | |
| 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") | |
| } | |
| # update the input in the Detailed Wifi Overview tab consistently with the Campus Wifi Dashboard tab | |
| 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) | |
| } | |
| # update the input in the Daily Overview tab consistently with the Campus Wifi Dashboard tab | |
| if(!(input$data_type_week == data_type_info)||!(identical(input$buildingType_week,building_type_info))||!(input$buildingStr_week==building_info)){ | |
| updateRadioButtons(session, "data_type_week", selected=data_type_info) | |
| updateCheckboxGroupInput(session, "buildingType_week", selected = building_type_info) | |
| if(!is.null(input$buildingType_week)){ | |
| buildingtype<-input$buildingType_week | |
| 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_week",choices = buildingname,selected=building_info) | |
| } | |
| } | |
| # when the users change input at the Week Overview tab | |
| else if(input$tabs=='week'){ | |
| data_type_info <- input$data_type_week | |
| building_type_info<-input$buildingType_week | |
| building_info<-input$buildingStr_week | |
| # update the input in the Campus Wifi Overview tab consistently with the Week Overview tab | |
| if(!(input$datatype == data_type_info)||!(identical(input$buildingtype,building_type_info))){ | |
| updateRadioButtons(session, "datatype", selected=data_type_info) | |
| updateCheckboxGroupInput(session, "buildingtype", selected = building_type_info) | |
| } | |
| # update the input in the Detailed Wifi Overview tab consistently with the Week Overview tab | |
| if(!(input$data_type_continous == data_type_info)||!(identical(input$buildingType,building_type_info))||!(input$buildingStr==building_info)){ | |
| updateRadioButtons(session, "data_type_continous", selected=data_type_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) | |
| } | |
| # update the input in the Campus Wifi Dashboard tab consistently with the Week Overview tab | |
| if(!(input$data_type_discrete == data_type_info)||!(identical(input$buildingType_discrete,building_type_info))||!(input$buildingStr_discrete==building_info)){ | |
| updateRadioButtons(session, "data_type__discrete", selected=data_type_info) | |
| updateCheckboxGroupInput(session, "buildingType_discrete", selected = building_type_info) | |
| # 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_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) | |
| } | |
| } | |
| }) | |
| #week tab | |
| output$week_ctrl <- renderUI({ | |
| week_dat <- reactive({ | |
| if (input$data_type_week == "user"){ | |
| range <- input$daterange | |
| rpi_wap_raw <- rpi_wap_raw %>% filter(buildingType %in% input$buildingType_week) %>% | |
| filter(abbrev == input$buildingStr_week) %>% filter(Date >= range[1]) %>% | |
| filter(Date <= range[2]) %>% dplyr::group_by(Date) %>% | |
| dplyr::summarize(day_sum = sum(usercount)) | |
| } | |
| else{ | |
| rpi_wap_raw <- rpi_wap_raw %>% filter(buildingType %in% input$buildingType_week) %>% | |
| filter(abbrev == input$buildingStr_week) %>% filter(Date >= range[1]) %>% | |
| filter(Date <= range[2]) %>% dplyr::group_by(Date, abbrev, Building, buildingType) %>% | |
| dplyr::summarize(day_sum = sum(maccount)) | |
| } | |
| }) | |
| 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) | |
| } | |
| } | |
| # 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_week)){ | |
| buildingtype<-input$buildingType_week | |
| buildingname<-alltype[buildingtype] | |
| } | |
| else{ | |
| buildingname<-c(alltype) | |
| } | |
| updateSelectInput(session, "buildingStr_week", | |
| choices = buildingname | |
| ) | |
| }) | |
| observe({ | |
| names <- buildinginfo %>% filter(abbrev == input$buildingStr_week) | |
| fullname <- names$Building | |
| output$barplot <- renderPlot({ | |
| 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(paste("WiFi Access from", input$daterange[1], "to", input$daterange[2], "for", fullname))+ | |
| theme_bw() + | |
| scale_fill_distiller(palette = "Purples", direction = "horizontal", name = "Count", | |
| 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) | |
| }) | |
| }) | |
| }) | |
| #campus dashboard tab | |
| output$interval_ctrl <- renderUI({ | |
| 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)){ | |
| rpi_wap_raw<-rpi_wap_raw %>% | |
| # Filter by selected date | |
| filter(Date==as_date(input$date_discrete)) | |
| } | |
| # if user select one or more building types, the plot should show the data of the buildings in those types. | |
| else{ | |
| rpi_wap_raw<-rpi_wap_raw %>% | |
| # Filter by selected date and building | |
| filter(Date==as_date(input$date_discrete))%>% | |
| 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{ | |
| rpi_wap_raw<-rpi_wap_raw %>% | |
| filter(Date==as_date(input$date_discrete)) %>% | |
| 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)){ | |
| rpi_wap_raw<-rpi_wap_raw %>% | |
| # Filter by selected date | |
| filter(Date==as_date(input$date_discrete)) %>% | |
| filter(Floor == floor) | |
| } | |
| # if user select one or more building types, the plot should show the data of the buildings in those types. | |
| else{ | |
| rpi_wap_raw<-rpi_wap_raw %>% | |
| # Filter by selected date and building | |
| filter(Date==as_date(input$date_discrete))%>% | |
| 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{ | |
| rpi_wap_raw<-rpi_wap_raw %>% | |
| filter(Date==as_date(input$date_discrete)) %>% | |
| filter(abbrev == input$buildingStr_discrete)%>% | |
| filter(time>=(hms::as_hms(input$timeRange[1]))) %>% | |
| filter(time<=(hms::as_hms(input$timeRange[2]))) %>% | |
| filter(Floor == floor) | |
| } | |
| } | |
| }) | |
| # 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)) | |
| } else { | |
| trimmedHitsData <- discrete_dat() %>% | |
| dplyr::group_by(devname, Date) %>% | |
| dplyr::summarize(total = sum(maccount)) | |
| } | |
| }) | |
| # 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 <- as.POSIXct(trimmedHitsData$time) | |
| trimmedHitsData | |
| } else { | |
| trimmedHitsData <- discrete_dat() %>% | |
| dplyr::group_by(time) %>% | |
| dplyr::summarize(total = sum(maccount)) | |
| trimmedHitsData$time <- as.POSIXct(trimmedHitsData$time) | |
| trimmedHitsData | |
| } | |
| }) | |
| discrete_dat_fin <- reactive({ | |
| if (input$data_type_discrete == "user") { | |
| all_discrete_dat <- discrete_dat() | |
| all_discrete_dat <- all_discrete_dat %>% | |
| dplyr::group_by(time, devname) %>% | |
| dplyr::summarize(Count = sum(usercount)) | |
| all_discrete_dat$time <- as.POSIXct(all_discrete_dat$time) | |
| all_discrete_dat | |
| } else { | |
| all_discrete_dat <- discrete_dat() | |
| all_discrete_dat <- all_discrete_dat %>% | |
| dplyr::group_by(time, devname) %>% | |
| dplyr::summarize(Count = sum(maccount)) | |
| all_discrete_dat$time <- as.POSIXct(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) | |
| } | |
| } | |
| write_hms <- function(time){ | |
| format(as.POSIXct(time, format = "%Y-%m-%dT%H:%M:%S"), "%H:%M:%S") | |
| } | |
| # Plot the graphs for the interval view | |
| observe({ | |
| # Main plot for interval data | |
| output$p1 <- renderPlot({ | |
| max_y <- max(discrete_dat_fin()$Count) | |
| ggplot(discrete_dat_fin(), aes(x = 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 devices in 30 minutes interval on", input$date_discrete, | |
| "from", hms::as_hms(input$timeRange[1]), "to", hms::as_hms(input$timeRange[2]))) + | |
| 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(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")) | |
| }, height=ht_main) | |
| output$discrete_plot1 <- renderUI({ | |
| if(nrow(discrete_dat())==0){ | |
| h1("There is no building under selected condition") | |
| } | |
| else{ | |
| plotOutput("p1",height = "100%") | |
| } | |
| }) | |
| # Plot for Wi-Fi connection by device | |
| output$p2 <- renderPlot({ | |
| max_y <- max(by_device()$total) | |
| ggplot(by_device(), aes(x=devname, y=total, fill=total)) + | |
| geom_bar(stat="identity") + | |
| xlab(label = "WAP Device Name") + | |
| ylab(label = "Nunber of access per WAP device") + | |
| ggtitle("WiFi access per WAP device") + | |
| 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")) | |
| }, height=ht_main) | |
| output$discrete_plot2 <- renderUI({ | |
| if(nrow(discrete_dat())==0){ | |
| h1(" ") | |
| } | |
| else{ | |
| plotOutput("p2",height = "100%") | |
| } | |
| }) | |
| # Plot for Wi-Fi connection by hour | |
| output$p3 <- renderPlot({ | |
| max_y <- max(by_time()$total) | |
| ggplot(by_time(), aes(x=time, y=total, fill=total)) + | |
| geom_bar(stat="identity") + | |
| xlab(label = "Time of day (24-hour clock)") + | |
| ylab(label = "Number of WAP device access by hour") + | |
| ggtitle(paste("WiFi access in 30 minutes interval on", input$date_discrete, | |
| "from", hms::as_hms(input$timeRange[1]), "to", hms::as_hms(input$timeRange[2]))) + | |
| 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(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")) | |
| }, height=ht) | |
| output$discrete_plot3 <- renderUI({ | |
| if(nrow(discrete_dat())==0){ | |
| h1(" ") | |
| } | |
| else{ | |
| plotOutput("p3",height = "100%") | |
| } | |
| }) | |
| # Plot for Wi-Fi data in continuous time | |
| output$p4 <- renderPlot({ | |
| max_y <- max(by_time()$total) | |
| ggplot(by_time(), aes(x=time, y = total)) + | |
| geom_line(data = by_time(), aes(x=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 = "Number of WAP device access by hour") + | |
| ggtitle(paste("WiFi access in 30 minutes interval \n (continuous representation)")) + | |
| theme_bw() + | |
| scale_colour_distiller(palette = "Purples", trans = "reverse") + | |
| scale_fill_distiller(palette = "Purples", direction = "horizontal", name = "Count", | |
| breaks = set_breaks(max_y)) + | |
| # scale_x_discrete(labels = function(labels) { | |
| # sapply(seq_along(labels), function(i) paste0(ifelse(i %% 2 == 0, '', '\n'), labels[i]))}) + | |
| 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(plot.margin = unit(c(1,0,1,0), "cm")) + | |
| theme(legend.key.size = unit(0.3, "cm")) | |
| }, height=ht) | |
| output$cont_plot <- renderUI({ | |
| if(nrow(discrete_dat())==0){ | |
| h1(" ") | |
| } | |
| else{ | |
| plotOutput("p4",height = "100%") | |
| } | |
| }) | |
| output$title_panel <- renderUI({ | |
| 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", input$date_discrete, "from", | |
| hms::as_hms(input$timeRange[1]), "to", hms::as_hms(input$timeRange[2]), "EST") | |
| } | |
| else{ | |
| bulding_type=toString(input$buildingType_discrete) | |
| paste("All Buildings of", tools::toTitleCase(bulding_type), "Type on", input$date_discrete, "from", | |
| hms::as_hms(input$timeRange[1]), "to", hms::as_hms(input$timeRange[2]), "EST") | |
| } | |
| } else{ | |
| row<- which(buildinginfo$abbrev == input$buildingStr_discrete) | |
| buildingname<-buildinginfo[row, 1] | |
| paste(buildingname, "on", input$date, "from", hms::as_hms(input$timeRange[1]), "to", hms::as_hms(input$timeRange[2]), "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", input$date_discrete, "from", | |
| hms::as_hms(input$timeRange[1]), "to", hms::as_hms(input$timeRange[2]), "EST") | |
| } | |
| else{ | |
| bulding_type=toString(input$buildingType_discrete) | |
| paste("Basements in All Buildings of", tools::toTitleCase(bulding_type), "Type on", input$date_discrete, "from", | |
| hms::as_hms(input$timeRange[1]), "to", hms::as_hms(input$timeRange[2]), "EST") | |
| } | |
| } else{ | |
| row<- which(buildinginfo$abbrev == input$buildingStr_discrete) | |
| buildingname<-buildinginfo[row, 1] | |
| paste("Basement of ", buildingname, "on", input$date, "from", hms::as_hms(input$timeRange[1]), "to", hms::as_hms(input$timeRange[2]), "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", input$date_discrete, "from", | |
| hms::as_hms(input$timeRange[1]), "to", hms::as_hms(input$timeRange[2]), "EST") | |
| } | |
| else{ | |
| bulding_type=toString(input$buildingType_discrete) | |
| paste(floor_name, "Floor of All Buildings of ", tools::toTitleCase(bulding_type), "Type on", input$date_discrete, "from", | |
| hms::as_hms(input$timeRange[1]), "to", hms::as_hms(input$timeRange[2]), "EST") | |
| } | |
| } else{ | |
| row<- which(buildinginfo$abbrev == input$buildingStr_discrete) | |
| buildingname<-buildinginfo[row, 1] | |
| paste(floor_name, "Floor of ", buildingname, "on", input$date, "from", hms::as_hms(input$timeRange[1]), "to", hms::as_hms(input$timeRange[2]), "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 | |
| ) | |
| }) | |
| output$title_panel_cont = renderUI({ | |
| if(input$buildingStr=="all"){ | |
| if(length(input$buildingType)==1){ | |
| paste("All building of", tools::toTitleCase(input$buildingType), "type on", input$date) | |
| } | |
| # if the user selects multiple building types | |
| else{ | |
| bulding_type=toString(input$buildingType) | |
| paste("All building of", tools::toTitleCase(bulding_type), "type on", input$date) | |
| } | |
| } else{ | |
| row<- which(buildinginfo$abbrev == input$buildingStr) | |
| buildingname<-buildinginfo[row, 1] | |
| paste(buildingname, "on", input$date) | |
| } | |
| }) | |
| 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<-rpi_wap_raw %>% | |
| # 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<-rpi_wap_raw %>% | |
| # 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<-rpi_wap_raw %>% | |
| # Filter by selected date, building types, and building | |
| filter(Date==as_date(input$date)) %>% | |
| filter(abbrev == input$buildingStr_discrete)%>% | |
| 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<-rpi_wap_raw %>% | |
| # 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<-rpi_wap_raw %>% | |
| # 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<-rpi_wap_raw %>% | |
| # Filter by selected date, building types, and building | |
| filter(Date==as_date(input$date)) %>% | |
| filter(abbrev == input$buildingStr_discrete)%>% | |
| group_by(devname) %>% | |
| mutate(max_count = max(maccount)) %>% | |
| ungroup() %>% | |
| filter(max_count>=input$threshold) | |
| } | |
| } | |
| # if(nrow(rpi_wap_raw)==0){ | |
| # shinyalert("Oops!", "Something went wrong.", type = "error"); | |
| # } | |
| }) | |
| plotHeight <- reactiveVal(1000) | |
| observe({ | |
| output$plot2 <- renderPlot({ | |
| #if there is data under selected condition. | |
| if(nrow(dat())!=0){ | |
| rpi_wap_raw<-dat() | |
| if(input$data_type_continous=="user"){ | |
| rpi_wap_raw %>% | |
| # Now plot! | |
| ggplot( aes(x=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 { | |
| rpi_wap_raw %>% | |
| # Now plot! | |
| ggplot( aes(x=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)") | |
| } | |
| } | |
| },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$continous_table <- DT::renderDataTable({ | |
| if(input$buildingStr!="all"&input$data_type_continous=="user"){ | |
| building_user<-paste("Total number of users in", tools::toTitleCase(input$buildingStr)) | |
| type_user<-paste("Total number of users in", tools::toTitleCase(input$buildingType), "type") | |
| max_building_user<-paste("Max number of users in", tools::toTitleCase(input$buildingStr)) | |
| 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<-hottest_time[!duplicated(hottest_time$devname),]$date_time | |
| 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 | |
| cont_table | |
| } | |
| },options = list(searching = FALSE)) | |
| 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) | |
| } | |
| } | |
| }) | |
| } | |
| # Run the application | |
| shinyApp(ui = ui, server = server) |