Skip to content
Permalink
Browse files
Merge pull request #36 from DataINCITE/darl-chenc29 
add acitivity tagging, remove housing, greek, and some other off camp…
  • Loading branch information
@chenc29
chenc29 committed Feb 18, 2021
2 parents 7c2c45c + b598427 commit 70c6e87e6085583a49687d4f2fccb2d4a161dfa4
Show file tree
Hide file tree
Showing 2 changed files with 73 additions and 32 deletions.
67 app.R
View file
@@ -167,7 +167,7 @@ ui <- dashboardPage(skin = "black", title = "RPI StudySafe",
fluidRow(column(pickerInput(inputId = 'building', label = tags$div(HTML("<b><span style = 'color: #54585a'>Choose a Building</span></b>")),
options = list(`live-search` = TRUE),
choices = byCat_single), width = 12),
column(prettySwitch(inputId = 'find_byActivity', inline = TRUE, label= tags$div(HTML("<b><span style = 'color: #54585a'>List by Activity</span></b>")), value = FALSE, status = "default", fill = TRUE, bigger = TRUE), width = 12)),
column(prettySwitch(inputId = 'find_byActivity', inline = TRUE, label= tags$div(HTML("<b><span style = 'color: #54585a'>List by Activity</span></b>")), value = FALSE, status = "default", fill = TRUE, bigger = TRUE), width = 12)),
actionButton(inputId = "submit_find", label = "Update Graphs", icon = icon('refresh'), class = "btn-default btn-lg", style = ' color: #990000; background-color: white' ,block = TRUE)
),
tags$div(HTML("<br></br>")),
@@ -224,9 +224,9 @@ ui <- dashboardPage(skin = "black", title = "RPI StudySafe",
inputPanel(dateInput('overview_date', label = tags$div(HTML("<b><span style = 'color: #54585a'>Choose a Date</span></b>")),
value = max_date, min = min_date, max = max_date),
selectInput('overview_time', label = tags$div(HTML("<b><span style = 'color: #54585a'>Choose a Time</span></b>")), time),
fluidRow(column(pickerInput(inputId = "buildingGraph", label = tags$div(HTML("<b><span style = 'color: #54585a'>Choose Buildings</span></b>")),
choices = byCat_single, options = list(`live-search` = TRUE), multiple = TRUE), width = 12),
column(prettySwitch(inputId = 'overview_byActivity', inline = TRUE, label= tags$div(HTML("<b><span style = 'color: #54585a'>List by Activity</span></b>")), value = FALSE, status = "default", fill = TRUE, bigger = TRUE), width = 12)),
fluidRow(column(pickerInput(inputId = "buildingGraph", label = tags$div(HTML("<b><span style = 'color: #54585a'>Choose Buildings</span></b>")),
choices = byCat_single, options = list(`live-search` = TRUE), multiple = TRUE), width = 12),
column(prettySwitch(inputId = 'overview_byActivity', inline = TRUE, label= tags$div(HTML("<b><span style = 'color: #54585a'>List by Activity</span></b>")), value = FALSE, status = "default", fill = TRUE, bigger = TRUE), width = 12)),
actionButton(inputId = "submit_campus", label = "Update Graphs", icon = icon('refresh'), class = "btn-default btn-lg", style = ' color: #990000; background-color: white' ,block = TRUE)

),
@@ -273,8 +273,8 @@ ui <- dashboardPage(skin = "black", title = "RPI StudySafe",
dateInput('map_date', label = tags$div(HTML("<b><span style = 'color: #54585a'>Choose a Date</span></b>")), value = max_date, min = min_date, max = max_date),
selectInput('map_time', label = tags$div(HTML("<b><span style = 'color: #54585a'>Choose a Time</span></b>")), time),
fluidRow(
column(pickerInput('map_building', inline = FALSE, label = tags$div(HTML("<b><span style = 'color: #54585a'>Choose a Building</span></b>")),
choices = byCat_multi,
column(pickerInput('map_building', inline = FALSE, label = tags$div(HTML("<b><span style = 'color: #54585a'>Choose a Building</span></b>")),
choices = byCat_multi,
selected = "None", multiple = FALSE, options = list(`live-search`=TRUE)), width = 12),
column(prettySwitch(inputId = 'map_byActivity', inline = TRUE, label= tags$div(HTML("<b><span style = 'color: #54585a'>List by Activity</span></b>")), value = FALSE, status = "default", fill = TRUE, bigger = TRUE), width = 12)),
actionButton(inputId = "submit_map", inline = TRUE, label = "Update Graphs", icon = icon('refresh'), class = "btn-default btn-lg", style = ' color: #990000; background-color: white', block = TRUE)
@@ -322,6 +322,21 @@ server <- function(input, output, session) {
#Activity Tagging Switch consistent across all tabs

#Select Building choices dependent on Acitivity Tagging Switch
observe({
if (input$find_byActivity == FALSE) {
updatePickerInput(session, inputId = "building", choices = byCat_single)
} else {
updatePickerInput(session, inputId = "building", choices = byAct_single)
}
})

observe({
if (input$map_byActivity == FALSE) {
updatePickerInput(session, inputId = 'map_building', choices = byCat_multi)
} else {
updatePickerInput(session, inputId = 'map_building', choices = byAct_multi)
}
})

#Now button to current time
observeEvent(input$NOW_find, {
@@ -336,13 +351,33 @@ server <- function(input, output, session) {
# Switch to "Quick Compare"
newtab <- switch(input$tabs, "find" = "overview","overview" = "find")
updateTabItems(session, "tabs", newtab)

#Update everything (Date, time, and one of building multi-select)
updateDateInput(session, "overview_date", value = input$date)
updateSelectInput(session, "overview_time", choices = time, selected = input$time)
updatePickerInput(session, "buildingGraph", label = "Building Multiselect",
choices = byCat_single,
selected = input$building)
observe({
if (input$overview_byActivity == FALSE){
updatePickerInput(session, "buildingGraph", label = "Building Multiselect",
choices = byCat_single,
selected = input$building)
} else {
updatePickerInput(session, "buildingGraph", label = "Building Multiselect",
choices = byAct_single,
selected = input$building)
}
})
})

observe({
if (input$overview_byActivity == FALSE){
updatePickerInput(session, "buildingGraph", label = "Building Multiselect",
choices = byCat_single,
selected = input$building)
} else {
updatePickerInput(session, "buildingGraph", label = "Building Multiselect",
choices = byAct_single,
selected = input$building)
}
})

observe({
@@ -534,7 +569,7 @@ server <- function(input, output, session) {
}else{'Has no information about capacity for this building at this time'}
})

#reccommendation calculations
#recommendation calculations
recnum <- 0
if(building_select %in% hits_per_wap_semester_by_building_max$Building){

@@ -549,7 +584,7 @@ server <- function(input, output, session) {
if(trend>=10){renum<-recnum - 0.5}else{recnum <- recnum + 0.5}
}else{}

#reccommendation text output
#recommendation text output
output$SmileFrown_summary <- renderText({
if((time_select %in% aggdf$Hour) & recnum>1){
"<b><em>This might be a good spot!</em></b>"
@@ -950,19 +985,19 @@ server <- function(input, output, session) {
# Using different color of star as icon and legend according to percentage of capacity
if (building_map_select$totalusers <= 0.25*building_map_select$capacity){
icon_url <- "images/blue_star.png"
html_legend <- "<img src='blue_star.png' style='width:20px;height:20px;'> Place to go <br/>"
html_legend <- "<img src='blue_star.png' style='width:20px;height:20px;'> Place of Selection <br/>"
}
else if (building_map_select$totalusers <= 0.5*building_map_select$capacity){
icon_url <- "images/beige_star.png"
html_legend <- "<img src='beige_star.png' style='width:20px;height:20px;'> Place to go <br/>"
html_legend <- "<img src='beige_star.png' style='width:20px;height:20px;'> Place of Selection <br/>"
}
else if (building_map_select$totalusers <= 0.75*building_map_select$capacity){
icon_url <- "images/lightred_star.png"
html_legend <- "<img src='lightred_star.png' style='width:20px;height:20px;'> Place to go <br/>"
html_legend <- "<img src='lightred_star.png' style='width:20px;height:20px;'> Place of Selection <br/>"
}
else {
icon_url <- "images/darkred_star.png"
html_legend <- "<img src='darkred_star.png' style='width:20px;height:20px;'> Place to go <br/>"
html_legend <- "<img src='darkred_star.png' style='width:20px;height:20px;'> Place of Selection <br/>"
}

# Make star icon
38 read_wapData.R
View file
@@ -54,11 +54,16 @@ rpi_wap_stats <- readRDS("../COVID_RPI_WiFi_Data/rpi_wifi_semester_day_summary.r
#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))

#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)
@@ -169,7 +174,7 @@ Research <- c('Materials Research Center',

#Other Resources/ Administrative Buildings
Admin <- c('J Building, Peoples Ave',
"President's House",
# "President's House",
"Proctors Building, downtown",
"Service Building, Peoples Ave",
"Troy Building",
@@ -183,34 +188,35 @@ Other <- c("City Station South",
"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")
# "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', 'greek')) %>% select(Building))$Building)
filter <- c(Favorites, Food, Wellness, Resources, Academic, Research, Admin, Other)
Sleep <- Sleep[which(!Sleep %in% filter)]
# 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))
"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)
"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(

0 comments on commit 70c6e87

Please sign in to comment.