Skip to content
Permalink
Browse files
Merge pull request #32 from DataINCITE/hacl-knissk 
Activity Tagging part one
  • Loading branch information
@knissk
knissk committed Dec 16, 2020
2 parents b67cfd5 + 08fa84c commit f812faf883dca994ea37e53d67cebdad45a6e85c
Show file tree
Hide file tree
Showing 2 changed files with 150 additions and 70 deletions.
80 app.R
View file
@@ -163,14 +163,10 @@ ui <- dashboardPage(skin = "black", title = "RPI StudySafe",
icon = icon("calendar"), block = TRUE),
inputPanel(dateInput('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('time', label = tags$div(HTML("<b><span style = 'color: #54585a'>Choose a Time</span></b>")), time),
pickerInput(inputId = 'building', label = tags$div(HTML("<b><span style = 'color: #54585a'>Choose a Building</span></b>")),
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 = 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)))),
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)),
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>")),
@@ -227,15 +223,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),
pickerInput(inputId = "buildingGraph", label = tags$div(HTML("<b><span style = 'color: #54585a'>Choose Buildings</span></b>")),
choices = 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))),
options = list(`live-search` = TRUE),
multiple = TRUE),
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)

),
@@ -262,7 +252,7 @@ ui <- dashboardPage(skin = "black", title = "RPI StudySafe",
#CAMPUS MAP TAB
tabItem(tabName="map",
tags$div(HTML("<br></br>")),
#wellPanel(

tags$div(
HTML("<h1 style = 'color: #ab2328'><b>Campus Map</b></h1>")
),
@@ -278,21 +268,15 @@ ui <- dashboardPage(skin = "black", title = "RPI StudySafe",

actionButton(inputId = "NOW_map", label = "NOW!", width = '100%', style = 'color: white; background-color: #990000; display:block; border-radius: 0%; border: 1px solid red;', icon = icon("calendar"), block = TRUE),
inputPanel(


selectInput('displaySelect', label = tags$div(HTML("<b><span style = 'color: #54585a'>Choose a Display</span></b>")), c('Map', 'Table')),
selectInput('displaySelect', label = tags$div(HTML("<b><span style = 'color: #54585a'>Choose a Display</span></b>")), c('Map', 'Table')),
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),
pickerInput('map_building', label = tags$div(HTML("<b><span style = 'color: #54585a'>Choose a Building</span></b>")),
choices = 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)),
selected = "None", multiple = FALSE, options = list(`live-search`=TRUE)),
actionButton(inputId = "submit_map", label = "Update Graphs", icon = icon('refresh'), class = "btn-default btn-lg", style = ' color: #990000; background-color: white' ,block = TRUE)
fluidRow(
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)
),
uiOutput("map_body"),
tags$div(HTML("<br></br>")),
@@ -311,7 +295,7 @@ ui <- dashboardPage(skin = "black", title = "RPI StudySafe",
</h1>
</footer>")

# )

)
),

@@ -333,11 +317,11 @@ ui <- dashboardPage(skin = "black", title = "RPI StudySafe",
# Define server logic required
server <- function(input, output, session) {

#ABOUT PAGE BODY
output$about_body <- renderUI({})
#CONSISTENT INPUT SELECTION ACROSS ALL TABS
#Activity Tagging Switch consistent across all tabs

#Select Building choices dependent on Acitivity Tagging Switch

#FIND A STUDY SPOT BODY
#Now button to current time
observeEvent(input$NOW_find, {
date_app$date <- max_date
@@ -356,12 +340,7 @@ server <- function(input, output, session) {
updateDateInput(session, "overview_date", value = input$date)
updateSelectInput(session, "overview_time", choices = time, selected = input$time)
updatePickerInput(session, "buildingGraph", label = "Building Multiselect",
choices = 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))),
choices = byCat_single,
selected = input$building)
})

@@ -387,7 +366,10 @@ server <- function(input, output, session) {

counter_find <- reactiveValues(number = -1) # Number of "Update Graphs" button being clicked

#The remaining body
#ABOUT TAB
output$about_body <- renderUI({})

#FIND A PLACE TO STUDY TAB
output$find_body <- renderUI({

# Observe whether "Update Graphs" button is clicked
@@ -590,7 +572,7 @@ server <- function(input, output, session) {



#QUICK COMPARE BODY
#QUICK COMPARE TAB
#Now button to current time
observeEvent(input$NOW_overview, {
date_app$date <- max_date
@@ -945,12 +927,7 @@ server <- function(input, output, session) {

# Update building selected of "Find a Place to Study"
updateSelectInput(session, "building",
choices = 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)),
choices = byCat_single,
selected = map_merge_filteredT_2[selectedRow,]$Building)
building_selected$building <- map_merge_filteredT_2[selectedRow,]$Building
}
@@ -1033,12 +1010,7 @@ server <- function(input, output, session) {

# Update building selected of "Find a Place to Study"
updateSelectInput(session, "building",
choices = 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)),
choices = byCat_single,
selected = marker_building$Building)
building_selected$building <- marker_building$Building

0 comments on commit f812faf

Please sign in to comment.