Skip to content
Permalink
Browse files
update app.R
  • Loading branch information
zhanr committed Nov 18, 2020
1 parent 54c6ec2 commit 07c174be1d4262aa7fc3315c1e7da6e17b39f163
Show file tree
Hide file tree
Showing 2 changed files with 48 additions and 30 deletions.
77 app.R
@@ -117,14 +117,17 @@ ui <- dashboardPage(skin = "black", title = "COVID SafeCampus",
width = NULL,
size = NULL
),
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)
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,
@@ -153,17 +156,19 @@ ui <- dashboardPage(skin = "black", title = "COVID SafeCampus",
"Other Off Campus" = "otherOffCampus",
"Other On Campus" = "otherOnCampus"),
selected = list("academic", "housing", "greek", "otherOnCampus")),
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),
radioButtons("size", "Select how you would like to view the size of the bubbles",
choices = c("Actual size" = "actual", "Same size" = "same"),
selected = "actual")),
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
@@ -620,6 +625,10 @@ server <- function(input, output, session) {
}
}

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
@@ -632,7 +641,9 @@ server <- function(input, output, session) {
ggtitle(paste("RPI 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() +
breaks = set_breaks(max_y)) +
scale_x_time(labels=write_hms) +
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)) +
@@ -687,6 +698,7 @@ server <- function(input, output, session) {
theme_bw() +
scale_fill_distiller(palette = "Purples", direction = "horizontal", name = "Count",
breaks = set_breaks(max_y)) +
scale_x_time(labels=write_hms) +
theme_ipsum() +
theme(plot.title = element_text(size = 16)) +
theme(axis.title.x = element_text(size = 12)) +
@@ -735,13 +747,22 @@ server <- function(input, output, session) {

output$title_panel <- renderUI({
if(input$buildingStr_discrete=="all"){
paste("All building 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")
if(length(input$buildingType_discrete)==1){
paste("All building 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 building 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<-as.character(buildinginfo[row, 1])
paste(buildingname, "on", input$date_discrete, "from", hms::as_hms(input$timeRange[1]), "to", hms::as_hms(input$timeRange[2]), "EST")
buildingname<-buildinginfo[row, 1]
paste(buildingname, "on", input$date, "from", hms::as_hms(input$timeRange[1]), "to", hms::as_hms(input$timeRange[2]), "EST")
}

})

})
@@ -751,11 +772,9 @@ server <- function(input, output, session) {
input$date_discrete
input$buildingType_discrete
input$timeRange}, {
if(nrow(dat())!=0){
if(nrow(discrete_dat_fin())!=0){
row_number<-length(unique(discrete_dat_fin()$devname))
if (row_number > 10000) {
ht_main(10000)
} else if(row_number==1){
if(row_number==1){
ht_main(row_number*75)
} else if(row_number>1 & row_number<=3){
ht_main(row_number*65)
@@ -1006,4 +1025,4 @@ server <- function(input, output, session) {
}

# Run the application
shinyApp(ui = ui, server = server)
shinyApp(ui = ui, server = server)
@@ -207,4 +207,3 @@ alltype<-list("academic"=academic,"greek"=greek,"housing"=housing,"otherOffCampu

#custom color palette
palette <- c("darkred", "red4", "red3", "indianred3", "salmon", "lightskyblue", "steelblue1", "royalblue1", "royalblue4", "navyblue", "midnightblue")

0 comments on commit 07c174b

Please sign in to comment.