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?
Go to file
 
 
Cannot retrieve contributors at this time
#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")