Permalink
Cannot retrieve contributors at this time
Name already in use
A tag already exists with the provided branch name. Many Git commands accept both tag and branch names, so creating this branch may cause unexpected behavior. Are you sure you want to create this branch?
IDEA-COVID-StudySafe/read_wapData.R
Go to fileThis commit does not belong to any branch on this repository, and may belong to a fork outside of the repository.
359 lines (316 sloc)
17.5 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
#Reading in the data and necessary libraries and data for RPI StudySafe App | |
#Created by Kara Kniss | |
################################################################################################################ | |
#READING IN THE NECESSARY LIBRARIES | |
################################################################################################################ | |
#load the packages if they are not already loaded | |
packages <- c("shiny", "shinydashboard", "shinyjs", "ggplot2", "shinyWidgets", "tidyverse", "tidyr", | |
"lubridate", "plyr", "scales", "zoo", "ggalt", "leaflet", "plotly", "wesanderson", "reactable") | |
new.packages <- packages[!(packages %in% installed.packages()[,"Package"])] | |
if (length(new.packages) > 0) { | |
install.packages(new.packages) | |
} | |
library(shiny) | |
library(shinydashboard) | |
library(shinyjs) | |
library(ggplot2) | |
library(shinyWidgets) | |
library(tidyverse) | |
library(tidyr) | |
library(lubridate) | |
library(plyr) | |
library(scales) | |
library(zoo) | |
library(ggalt) | |
library(leaflet) | |
library(plotly) | |
library(wesanderson) | |
library(reactable) | |
library(DT) | |
library(dplyr) | |
################################################################################################################ | |
###READING IN NECESSARY FILES | |
################################################################################################################ | |
#rpi_wap_raw(one month): Min_30, devname, maccount, usercount, datetime, date_time, Date, Building, Floor, Room, latitude, longitude, buldingType, abbrev, time | |
rpi_wap_raw <- readRDS("../COVID_RPI_WiFi_Data/rpi_wap_raw.rds") | |
#combined_wap_data(one month): building, time, Date, latitude, longitude, buildingType, abbrev, users, macs, | |
combined_wap_data <- readRDS("../COVID_RPI_WiFi_Data/combined_wap_data.rds") | |
#rpi_wap_stats: devname, Day, maccount_mean, maccount_med, maccount_max, usrecount_mean, usercount_med, usercount_max | |
rpi_wap_stats <- readRDS("../COVID_RPI_WiFi_Data/rpi_wifi_semester_day_summary.rds") | |
#rpi_wap_week(whole semester): devname, maccount, usercount, datetime, date_time, Date, Day | |
#rpi_wap_week <- readRDS("../COVID_RPI_WiFi_Data/rpi_wifi_semester_extended.rds") | |
#buildinginfo: Building, latitude, longitude, buildingType, abbrev | |
#buildinginfo <- readRDS("../COVID_RPI_WiFi_Data/buildinginfo.rds") | |
#user_prediction: Building, weekday, Hour, users, Mean_Usercount, latitude, longitude, buildingType | |
user_predictions_fl <- readRDS("../COVID_RPI_WiFi_Data/median_last3wks_with_floors.rds") | |
################################################################################################################ | |
###CLEANING DATA | |
################################################################################################################ | |
#rpi_wap_raw: devname, users, Date, Building, Hour, lat, lng, BuildingType | |
rpi_wap_raw <- rpi_wap_raw %>% mutate(Hour = hour(as.POSIXct(time))) %>% select(devname, usercount, Date, Building, Hour, latitude, longitude, buildingType) | |
colnames(rpi_wap_raw) <- c('devname', 'users', 'Date', 'Building', 'Hour', 'lat', 'lng', 'BuildingType') | |
remove_list <- c("SAE, 12 Myrtle Ave off Pawling Ave", "Peoples Ave #1002", "Peoples Ave #1516", "Peoples Ave #901", "Peoples Ave #907", "President's House") | |
rpi_wap_raw <- rpi_wap_raw %>% filter(BuildingType != "housing" & BuildingType != "greek") %>% | |
filter(!(Building %in% remove_list)) | |
#combined_wap_data: Building, Hour, lat, lng, BuildingType | |
rpi_wap_last7 <- combined_wap_data %>% mutate(Hour = hour(as.POSIXct(time))) %>% select(Building, users, Date, Building, Hour, latitude, longitude, buildingType) | |
rpi_wap_last7 <- rpi_wap_last7 %>% group_by(Building, Date, Hour, latitude, longitude, buildingType) %>% summarise_all(funs(max)) %>% ungroup() | |
colnames(rpi_wap_last7) <- c('Building', 'Date', 'Hour','lat','lng', 'BuildingType', 'users' ) | |
rpi_wap_last7 <- rpi_wap_last7 %>% filter(BuildingType != "housing" & BuildingType != "greek") %>% | |
filter(!(Building %in% remove_list)) | |
rpi_wap_last7$weekday <- weekdays(rpi_wap_last7$Date) | |
#bldgs(getting buildings to append to devnames): devname, Building | |
bldgs <- rpi_wap_raw %>% filter(Date == min(rpi_wap_last7$Date)+1) %>% filter(Hour==12) %>% select(devname, Building) | |
# hits_per_wap_semester_by_building_max(getting maximum number of users for each building): Building, capacity | |
hits_per_wap_semester_by_building_max <- merge(rpi_wap_stats, bldgs, by.x= "devname", by.y="devname") | |
hits_per_wap_semester_by_building_max <- hits_per_wap_semester_by_building_max %>% group_by(devname, Building, Day) %>% summarise_all(funs(max)) %>% ungroup() %>% select(devname, Day, usercount_max, Building) | |
hits_per_wap_semester_by_building_max <- hits_per_wap_semester_by_building_max[,2:ncol(hits_per_wap_semester_by_building_max)] | |
hits_per_wap_semester_by_building_max <- hits_per_wap_semester_by_building_max %>% group_by(Building, Day) %>% summarise_all(funs(sum)) %>% ungroup() | |
hits_per_wap_semester_by_building_max <- hits_per_wap_semester_by_building_max %>% group_by(Building) %>% summarise_all(funs(max)) %>% ungroup() %>% select(Building, usercount_max) | |
colnames(hits_per_wap_semester_by_building_max) <- c('Building', 'capacity') | |
user_predictions <- user_predictions_fl %>% | |
dplyr::group_by(Building, Weekday, Hour, lat, lng, BuildingType) %>% | |
dplyr::summarize(totalusers = sum(users)) %>% | |
ungroup() | |
names(user_predictions_fl)[names(user_predictions_fl) == 'Weekday'] <- 'weekday' | |
names(user_predictions)[names(user_predictions) == 'Weekday'] <- 'weekday' | |
names(user_predictions)[names(user_predictions) == 'totalusers'] <- 'users' | |
################################################################################################################ | |
## DEFININING LISTS AND DATA FRAMES FOR CONVENIENCE | |
################################################################################################################ | |
#Setting Colors | |
lightcolor <- "#ff2500" | |
darkcolor <- "#9a1600" | |
#creating a time list for the graphs so they aren't in military time | |
time <- list('12:00am'= 0,'1:00am'=1, '2:00am'=2, '3:00am'=3, '4:00am'=4, '5:00am'=5, '6:00am'=6, '7:00am'=7, '8:00am'=8, '9:00am'=9, '10:00am'=10, "11:00am"=11, "12:00pm"=12, "1:00pm"=13, "2:00pm"=14, "3:00pm"=15, "4:00pm"=16, "5:00pm"=17, "6:00pm"=18, "7:00pm"=19, "8:00pm"=20, "9:00pm"=21,"10:00pm"=22, "11:00pm"=23) | |
Time_num <- c(0:23) | |
Time_AMPM <- c('12am', '1am', '2am', '3am', '4am', '5am', '6am', '7am', '8am', '9am', '10am', '11am', '12pm', '1pm', '2pm','3pm', '4pm', '5pm', '6pm', '7pm', '8pm', '9pm', '10pm', '11pm' ) | |
Time_noLabel <- c(12,1,2,3,4,5,6,7,8,9,10,11,12,1,2,3,4,5,6,7,8,9,10,11) | |
time.data <- data.frame(Time_num, Time_AMPM, Time_noLabel, stringsAsFactors=FALSE) | |
#defining the max date and min date info | |
min_date <- min(rpi_wap_last7$Date) | |
max_date <- max(rpi_wap_last7$Date) | |
max_time_of_max_date <- max(rpi_wap_last7[rpi_wap_last7$Date == max(rpi_wap_last7$Date),]$Hour)+1 | |
min_time_of_min_date <- min(rpi_wap_last7[rpi_wap_last7$Date == min(rpi_wap_last7$Date),]$Hour)+1 | |
date_app <- reactiveValues(date = max_date) # Remember the input date for future use | |
time_app <- reactiveValues(time = 0) # Remember the input time for future use | |
building_selected <- reactiveValues(building = 'Amos Eaton') # Remember the name of selected building for future use | |
data <- reactiveValues(clickedMarker=NULL) | |
map_latitude <- reactiveValues(lat=0) | |
map_longitude <- reactiveValues(lng=0) | |
hr <- as.integer(format(Sys.time(), "%H")) | |
hr_now <- reactiveValues(time=hr) | |
map_click <- reactive({"Amos Eaton"}) | |
#weekday information | |
#getting selected weekday | |
day <- c("Sunday", "Monday", "Tuesday", "Wednesday", "Thursday", "Friday", "Saturday" ) | |
dayVal<- c(1,2,3,4,5,6,7) | |
weekpair <- data.frame(day,dayVal, stringsAsFactors=FALSE) | |
#weekly3_stats(Getting average users of the last three weeks by day): Building, Hour, users, dayVal | |
weekly3_stats <- rpi_wap_last7 %>% filter(Date >= min_date -21) %>% mutate(dayVal = wday(Date)) %>% select(Building, Hour, users, dayVal) | |
weekly3_stats <- weekly3_stats %>% group_by(Building, dayVal, Hour) %>% summarise_all(funs(mean)) %>% ungroup() | |
weekly3_stats$users <- round(weekly3_stats$users) | |
################################################################################################################ | |
## Activity Tagging | |
################################################################################################################ | |
#Student Favorites | |
Favorites <- c('CII', | |
'DCC', | |
'Folsom Library', | |
'Rensselaer Union', | |
'Voorhees Computing Center') | |
#Grab a Bite to Eat: places to get food and drinks | |
Food <- c('Moes, College Ave', | |
'Commons Dining Hall', | |
'Russell Sage Dining Hall', | |
'Blitman Commons') | |
#Wellness: gyms, activity areas | |
Wellness <- c('ASRC', | |
'ECAV arena', | |
'ECAV stadium', | |
'Houston Field House', | |
'Fitness Center', | |
'87 Gym', | |
'Robison Pool') | |
#Student Resources, lounges, etc | |
Resources <- c("15th St #1528, Grad Ed", | |
"Admissions", | |
"ASRC auto shop", | |
"ASRC garage", | |
"East Campus Community Center", | |
"Off Campus Commons, 1525 15th St", | |
"Visitor Information Center, Public Safety") | |
#Academic: Academic buildings | |
Academic <- c('Academy Hall', | |
'Amos Eaton', | |
'Carnegie Building', | |
'EMPAC', | |
'Greene Building', | |
'JEC', | |
'Lally Building', | |
'Pittsburgh Building', | |
'Sage Lab', | |
'Science Center', | |
'Winslow Building', | |
'Ricketts Building', | |
"West Hall") | |
#Research Buildings and Centers | |
Research <- c('Materials Research Center', | |
'CBIS', | |
'LINAC/NES, Tibbits Ave', | |
'Polymer Center', | |
'Watervliet Facility, 805 25th St, Watervliet', | |
'DFWI, Lake George', | |
'Jordan Road #405, Tech Park, CCI', | |
'Jordan Road #465, Tech Park', | |
'Cogswell Lab') | |
#Other Resources/ Administrative Buildings | |
Admin <- c('J Building, Peoples Ave', | |
# "President's House", | |
"Proctors Building, downtown", | |
"Service Building, Peoples Ave", | |
"Troy Building", | |
"Walker Lab", | |
"Gurley Building, downtown", | |
"H Building") | |
#Other Buildings, off and near Campus | |
Other <- c("City Station South", | |
"City Station West", | |
"College Ave #90, EMPAC resident artists", | |
"College Ave #92, RPI Ambulance", | |
"Old Bumstead Garage, behind Colonie Apts", | |
# "SAE, 12 Myrtle Ave off Pawling Ave", | |
"Rensselaer at Hartford") | |
# "Peoples Ave #1002", | |
# "Peoples Ave #1516", | |
# "Peoples Ave #901", | |
# "Peoples Ave #907") | |
#Sleep: Housing | |
# Sleep <- unique((rpi_wap_last7 %>% filter(BuildingType %in% c('housing')) %>% select(Building))$Building) | |
# Sleep <- unique((rpi_wap_last7 %>% filter(BuildingType %in% c('housing', 'greek')) %>% select(Building))$Building) | |
# filter <- c(Favorites, Food, Wellness, Resources, Academic, Research, Admin, Other) | |
# Sleep <- Sleep[which(!Sleep %in% filter)] | |
#List for selectInput | |
byCat_single <- list( | |
"Academic" = as.vector(unique((rpi_wap_last7 %>% filter(BuildingType=='academic') %>% select(Building))$Building)), | |
"Other On Campus" = as.vector(unique((rpi_wap_last7 %>% filter(BuildingType=='otherOnCampus') %>% select(Building))$Building)), | |
"Other Off Campus" = as.vector(unique((rpi_wap_last7 %>% filter(BuildingType=='otherOffCampus') %>% select(Building))$Building)) | |
# "Greek" = as.vector(unique((rpi_wap_last7 %>% filter(BuildingType=='greek') %>% select(Building))$Building)), | |
# "Housing" = as.vector(unique((rpi_wap_last7 %>% filter(BuildingType=='housing') %>% select(Building))$Building)) | |
) | |
byCat_multi <- list( | |
"Nothing Selected" = as.vector('None'), | |
"Academic" = as.vector(unique(rpi_wap_last7 %>% filter(BuildingType=='academic') %>% select(Building))$Building), | |
"Other On Campus" = as.vector(unique(rpi_wap_last7 %>% filter(BuildingType=='otherOnCampus') %>% select(Building))$Building), | |
"Other Off Campus" = as.vector(unique(rpi_wap_last7 %>% filter(BuildingType=='otherOffCampus') %>% select(Building))$Building) | |
# "Greek" = as.vector(unique(rpi_wap_last7 %>% filter(BuildingType=='greek') %>% select(Building))$Building), | |
# "Housing" = as.vector(unique(rpi_wap_last7 %>% filter(BuildingType=='housing') %>% select(Building))$Building) | |
) | |
byAct_single <- list( | |
"Common Favorites" = as.vector(Favorites), | |
"Academic Buildings" = as.vector(Academic), | |
"Food and Drinks" = as.vector(Food), | |
"Wellness" = as.vector(Wellness), | |
"Student Resources" = as.vector(Resources), | |
"Administration" = as.vector(Admin), | |
"Research Facilities" = as.vector(Research), | |
"Other" = as.vector(Other) | |
) | |
byAct_multi <- list( | |
"Nothing Selected" = as.vector('None'), | |
"Common Favorites" = as.vector(Favorites), | |
"Academic Buildings" = as.vector(Academic), | |
"Food and Drinks" = as.vector(Food), | |
"Wellness" = as.vector(Wellness), | |
"Student Resources" = as.vector(Resources), | |
"Administration" = as.vector(Admin), | |
"Research Facilities" = as.vector(Research), | |
"Other" = as.vector(Other) | |
) | |
####################################### Function for new version of app ################################################# | |
sun_dat <- rpi_wap_last7 %>% filter(weekday == "Sunday") | |
mon_dat <- rpi_wap_last7 %>% filter(weekday == "Monday") | |
tue_dat <- rpi_wap_last7 %>% filter(weekday == "Tuesday") | |
wed_dat <- rpi_wap_last7 %>% filter(weekday == "Wednesday") | |
thu_dat <- rpi_wap_last7 %>% filter(weekday == "Thursday") | |
fri_dat <- rpi_wap_last7 %>% filter(weekday == "Friday") | |
sat_dat <- rpi_wap_last7 %>% filter(weekday == "Saturday") | |
# Function to get map information for leaflet map | |
get_map_info <- function(dat, hour, hits_per_wap_semester_by_building_max) { | |
map_info <- dat %>% filter(Hour==hour) %>% | |
select(lat, lng, BuildingType,Building, users) %>% | |
group_by(lat, lng, BuildingType,Building) %>% | |
dplyr::summarise(totalusers = sum(users)) | |
map_info <- merge(map_info, hits_per_wap_semester_by_building_max, by.x= "Building", by.y="Building") | |
} | |
# Function to get marker color on leaflet map | |
getColor <- function(dat) { | |
mapply(function(totalusers, capacity) { | |
if(totalusers <= 0.25*capacity) {"darkblue"} | |
else if(totalusers <= 0.5*capacity) {"lightblue"} | |
else if(totalusers <= 0.75*capacity) {"lightred"} | |
else {"red"}}, | |
dat$totalusers, dat$capacity) | |
} | |
# Function to create icon on leaflet map | |
getIcon <- function(dat){ | |
icons <- awesomeIcons( | |
icon = 'ios-close', | |
iconColor = 'black', | |
library = 'ion', | |
markerColor = getColor(dat)) | |
} | |
# Function to generate leaflet map | |
get_map <- function(dat, lat, lng) { | |
leaf_map <- leaflet(dat) %>% | |
addAwesomeMarkers(icon=getIcon(dat)) %>% | |
addTiles() %>%setView( lng = lng, lat = lat, zoom = 16 ) %>% | |
addLegend(position = "topleft", colors = c("#235878", "#65b7de", "#f28e80", "#c44130"), labels = c("0% ~ 25%", "25% ~ 50%", "50% ~ 75%", "75% ~ 100%")) | |
} | |
# Function to generate comments on how busy the building is | |
busy_text <- function(dat, building_select, hits_per_wap_semester_by_building_max){ | |
building_select_cap <- subset(hits_per_wap_semester_by_building_max, hits_per_wap_semester_by_building_max$Building == building_select) | |
cap <- dat$users / building_select_cap$capacity | |
if(cap <= .25){busy_summary <- "usually not busy"} | |
else if(cap <= .5 & cap > .25){busy_summary <- "usually not too busy"} | |
else if(cap <= .75 & cap > .5){busy_summary <- "usually a bit busy"} | |
else {busy_summary <- "usually as busy as it can get"} | |
} | |
# Function to generate capacity line on bar plot | |
capacity_intercept <- function(capacity){ | |
c1 <- capacity * .25 | |
c2 <- capacity * .5 | |
c3 <- capacity * .75 | |
cut <- c(c1, c2, c3, capacity) | |
} | |
cbPalette <- c("#8dd3c7", "#ffffb3", "#bebada", "#fb8072", "#80b1d3", "#fdb462", "#b3de69", "#fccde5", "#d9d9d9", "#bc80bd") | |
# Function to make bar plot | |
make_plot <- function(dat, time_now, building_select, hits_per_wap_semester_by_building_max){ | |
building_select_cap <- subset(hits_per_wap_semester_by_building_max, hits_per_wap_semester_by_building_max$Building == building_select) | |
cap_line <- capacity_intercept(building_select_cap$capacity) | |
dat$Floor <- factor(dat$Floor) | |
ggplot(dat, aes(x=factor(Hour), y=users, fill=forcats::fct_rev(Floor))) + | |
# ggplot(dat, aes(x=factor(Hour), y=users, fill=(Hour==time_now))) + | |
geom_rect(alpha.f=0.1, xmin=as.integer(time_now)+.5, xmax=as.integer(time_now)+1.5, ymin=-Inf, ymax=Inf, fill="#c8f7c8") + | |
geom_bar(stat="identity", color = "black") + | |
# scale_fill_manual(values=cbPalette) + | |
scale_fill_manual(values = c("0"="#8dd3c7", "1"="#ffffb3", "2"="#bebada", "3"="#fb8072", "4"="#80b1d3", "5"="fdb462", | |
"6"="#b3de69", "7"="fccde5", "8"="#d9d9d9", "9"="#bc80bd")) + | |
# scale_fill_manual(values=c("skyblue3","mediumvioletred")) + | |
# geom_vline(xintercept = as.integer(time_now)+1, linetype = "dotted") + | |
geom_hline(yintercept = cap_line, linetype = "dotted") + | |
scale_x_discrete(labels= Time_AMPM) + | |
scale_y_continuous(breaks = cap_line, labels = c("25%", "50%", "75%", "100%")) + | |
ylab("Building Capacity") + | |
labs(fill = "Floor") + | |
theme(panel.grid.major = element_blank(), | |
panel.grid.minor = element_blank(), | |
panel.background = element_blank(), | |
plot.background = element_blank(), | |
axis.ticks.y = element_blank(), | |
axis.ticks.x = element_blank(), | |
axis.title.x=element_blank(), | |
legend.position="bottom", | |
legend.background = element_blank()) | |
} | |
icon <- awesomeIcons(icon = 'ios-close', iconColor="black", library='ion', markerColor="green") |