I've recently created a Shiny App to track the number of parking citations issued over the course of a day, broken down by hour and filtered by time frame, location, violation, and officer. The App seems to work perfectly fine when I run it locally:
When I run the Shiny App on the shinyapps.io server, however, all the rows for my (Hour_of_Day) factor become missing (NA)! Everything else seems to work fine except that the Time of Day Graph visualizes all citations issued as being NA along the "Time of Day (Hour)" axis and the Time of Day (Hour) appears missing on the Data Table.
Link to Citation App: https://cypher-trial.shinyapps.io/Citation-Demo-App/
The log does not display any errors or warning when the app is running:
2019-03-01T16:37:40.091250+00:00 shinyapps[741215]: Server version: 1.7.0-11
2019-03-01T16:37:40.091254+00:00 shinyapps[741215]: LANG: en_US.UTF-8
2019-03-01T16:37:40.091285+00:00 shinyapps[741215]: shiny version: 1.2.0
2019-03-01T16:37:40.091286+00:00 shinyapps[741215]: httpuv version: 1.4.5.1
2019-03-01T16:37:40.091283+00:00 shinyapps[741215]: R version: 3.5.1
2019-03-01T16:37:40.091300+00:00 shinyapps[741215]: knitr version: 1.21
2019-03-01T16:37:40.091295+00:00 shinyapps[741215]: rmarkdown version: 1.11
2019-03-01T16:37:40.091342+00:00 shinyapps[741215]: RJSONIO version: NA
2019-03-01T16:37:40.091330+00:00 shinyapps[741215]: jsonlite version: 1.6
2019-03-01T16:37:40.091344+00:00 shinyapps[741215]: htmltools version: 0.3.6
2019-03-01T16:37:40.091508+00:00 shinyapps[741215]: Using pandoc at /opt/connect/ext/pandoc2
2019-03-01T16:37:40.377314+00:00 shinyapps[741215]: Using jsonlite for JSON processing
2019-03-01T16:37:40.382636+00:00 shinyapps[741215]: Starting R with process ID: '304'
2019-03-01T16:37:40.382634+00:00 shinyapps[741215]:
2019-03-01T16:37:41.384608+00:00 shinyapps[741215]: ── Attaching packages ─────────────────────────────────────── tidyverse 1.2.1 ──
2019-03-01T16:37:41.392188+00:00 shinyapps[741215]: ✔ ggplot2 3.1.0 ✔ purrr 0.3.0
2019-03-01T16:37:41.537666+00:00 shinyapps[741215]: ── Conflicts ────────────────────────────────────────── tidyverse_conflicts() ──
2019-03-01T16:37:41.392189+00:00 shinyapps[741215]: ✔ tibble 2.0.1 ✔ dplyr 0.8.0.1
2019-03-01T16:37:41.392189+00:00 shinyapps[741215]: ✔ tidyr 0.8.2 ✔ stringr 1.4.0
2019-03-01T16:37:41.392190+00:00 shinyapps[741215]: ✔ readr 1.3.1 ✔ forcats 0.4.0
2019-03-01T16:37:41.537669+00:00 shinyapps[741215]: ✖ dplyr::filter() masks stats::filter()
2019-03-01T16:37:41.537670+00:00 shinyapps[741215]: ✖ dplyr::lag() masks stats::lag()
2019-03-01T16:37:41.608011+00:00 shinyapps[741215]:
2019-03-01T16:37:41.608014+00:00 shinyapps[741215]: Attaching package: ‘lubridate’
2019-03-01T16:37:41.608015+00:00 shinyapps[741215]:
2019-03-01T16:37:41.608538+00:00 shinyapps[741215]: The following object is masked from ‘package:hms’:
2019-03-01T16:37:41.608540+00:00 shinyapps[741215]: hms
2019-03-01T16:37:41.608539+00:00 shinyapps[741215]:
2019-03-01T16:37:41.608540+00:00 shinyapps[741215]:
2019-03-01T16:37:41.610781+00:00 shinyapps[741215]: The following object is masked from ‘package:base’:
2019-03-01T16:37:41.610782+00:00 shinyapps[741215]:
2019-03-01T16:37:41.610783+00:00 shinyapps[741215]: date
2019-03-01T16:37:41.610784+00:00 shinyapps[741215]:
2019-03-01T16:37:41.641980+00:00 shinyapps[741215]:
2019-03-01T16:37:41.641981+00:00 shinyapps[741215]: Attaching package: ‘shinydashboard’
2019-03-01T16:37:41.641982+00:00 shinyapps[741215]:
2019-03-01T16:37:41.642336+00:00 shinyapps[741215]: The following object is masked from ‘package:graphics’:
2019-03-01T16:37:41.642338+00:00 shinyapps[741215]:
2019-03-01T16:37:41.642338+00:00 shinyapps[741215]: box
2019-03-01T16:37:41.642339+00:00 shinyapps[741215]:
2019-03-01T16:37:41.659996+00:00 shinyapps[741215]:
2019-03-01T16:37:41.659998+00:00 shinyapps[741215]: Attaching package: ‘DT’
2019-03-01T16:37:41.659999+00:00 shinyapps[741215]:
2019-03-01T16:37:41.660366+00:00 shinyapps[741215]: The following objects are masked from ‘package:shiny’:
2019-03-01T16:37:41.660368+00:00 shinyapps[741215]:
2019-03-01T16:37:41.660369+00:00 shinyapps[741215]:
2019-03-01T16:37:41.660369+00:00 shinyapps[741215]: dataTableOutput, renderDataTable
2019-03-01T16:37:44.162622+00:00 shinyapps[741215]:
2019-03-01T16:37:44.162625+00:00 shinyapps[741215]: Listening on http://127.0.0.1:40755
I'm not sure as to what is causing the 'Hour_of_Day' to misbehave and only result in NA, especially given that the local Shiny App seems to work perfectly fine. Any suggestions on how I can fix the problem will be greatly appreciated!
The data for my app can be found here:
https://github.com/ecypher/citation-demo-app/blob/master/Shiny%20Parking%20Trial%20Dataset.txt
My Shiny Citation App Code:
# Citations by Time of Day App
#Set / Read Directory
#-------------------------------------------------------------------------------#
#-------------------------------------------------------------------------------#
#Load Packages
library("tidyverse")
library("hms")
library("lubridate")
library("shiny")
library("shinyWidgets")
library("shinydashboard")
library("DT")
#Read Parking Dataset
x <- read.csv("Shiny Parking Trial Dataset.txt")
#Reformat Data
#Select and Relabel Variables
y <- x %>% select("Citation Number" = CON_TICKET_ID, "Officer" = STF_DESCRIPTION, "Location" = CLM_DESCRIPTION, "Violation" = VIC_DESCRIPTION)
#Update Officer Strings
updated_officer <- y %>% mutate_all(~str_replace_all(., "[//(//)]", ""))
updated_officer_2 <- updated_officer %>% mutate_all(~str_replace_all(., " Mobile Device User", ""))
updated_officer_3 <- updated_officer_2 %>% mutate_all(~str_replace_all(., " Mobile Device Use", ""))
violation_parse <- updated_officer_3 %>% mutate_all(~str_replace_all(., " -", ""))
# Create Variables for Dates and Times
set_dates <- as.data.frame(mdy_hms(x$CON_ISSUE_DATE))
Q <- set_dates %>% select("Issue_Time" = `mdy_hms(x$CON_ISSUE_DATE)`)
Hours <- format(Q, "%H%:%M:%S")
time_to_character <- as.character(Hours$Issue_Time)
Issue_Time <- parse_hms(time_to_character)
comb <- cbind(violation_parse,Issue_Time)
FINAL <- comb %>% mutate(Hour = hour(comb$Issue_Time))
FINAL_ADD_STRING <- as.character(FINAL$Hour)
ZZZ <- factor(FINAL_ADD_STRING, levels = c("0","1","2","3","4","5","6","7","8","9","10","11","12","13","14","15","16","17","18","19","20","21","22","23","24"))
levels(ZZZ) <- list("12AM" = "0","1AM" = "1","2AM" = "2","3AM" = "3","4AM" = "4","5AM" = "5","6AM" = "6","7AM" = "7","8AM" = "8","9AM" = "9","10AM" = "10","11AM" = "11","12PM" = "12","1PM" = "13","2PM" = "14","3PM" = "15","4PM" = "16","5PM" = "17","6PM" = "18","7PM" = "19","8PM" = "20","9PM" = "21","10PM" = "22","11PM" = "23","12.PM" = "24")
Hour_of_Day <- ZZZ
List_Date_Time <- format(Q$Issue_Time, "%m/%d/%y %I:%M:%S %p")
Reformat_Date <- date(Q$Issue_Time)
#Put Everything Together
Clean_Complit <- cbind.data.frame(List_Date_Time,FINAL,Hour_of_Day,Reformat_Date)
Clean_Complete <- Clean_Complit %>% rename("Date / Time" = List_Date_Time)
# Create Lists for Violation, Location, and Officer
# List Violation
Violation_Count <- Clean_Complete %>% count(Violation)
Violation_Grab <- Violation_Count %>% select(Violation)
Violation_List <- as.list(Violation_Grab)
as.data.frame(Violation_Grab)
Violation_Options <- data.frame(Violation_Grab, row.names = Violation_Grab$Violation)
# List Location
Location_Count <- Clean_Complete %>% count(Location)
Location_Grab <- Location_Count %>% select(Location)
Location_List <- as.list(Location_Grab)
as.data.frame(Location_Grab)
Location_Options <- data.frame(Location_Grab, row.names = Location_Grab$Location)
# List Officer
Officer_Count <- Clean_Complete %>% count(Officer)
Officer_Grab <- Officer_Count %>% select(Officer)
Officer_List <- Officer_Grab
as.data.frame(Officer_Grab)
Officer_Options <- data.frame(Officer_Grab, row.names = Officer_Grab$Officer)
#Preset Colors
barfill <- "forestgreen"
barfill_2 <- "blue4"
barlines <- "black"
#Establish Theme
hw <- theme_gray()+ theme(
plot.title=element_text(hjust=0.5, size = 24),
axis.title.x = element_text(size=14),
axis.title.y = element_text(size=14),
plot.subtitle=element_text(hjust=0.5),
plot.caption=element_text(hjust=-.5),
# strip.text.y = element_blank(),
strip.background=element_rect(fill=rgb(.9,.95,1),
colour=gray(.5), size=.2),
panel.border=element_rect(fill=FALSE,colour=gray(.70)),
panel.grid.minor.y = element_blank(),
panel.grid.minor.x = element_blank(),
panel.spacing.x = unit(0.10,"cm"),
panel.spacing.y = unit(0.05,"cm"),
# axis.ticks.y= element_blank()
axis.ticks=element_blank(),
axis.text=element_text(colour="black"),
axis.text.x = element_text(size = 9),
axis.text.y=element_blank())
hy <- theme_gray()+ theme(
plot.title=element_text(hjust=0.5, size = 24),
axis.title.x = element_text(size=20),
axis.title.y = element_text(size=14),
plot.subtitle=element_text(hjust=0.5),
plot.caption=element_text(hjust=-.5),
# strip.text.y = element_blank(),
strip.background=element_rect(fill=rgb(.9,.95,1),
colour=gray(.5), size=.2),
panel.border=element_rect(fill=FALSE,colour=gray(.70)),
panel.grid.major.y = element_blank(),
panel.grid.minor.y = element_blank(),
panel.grid.minor.x = element_blank(),
panel.spacing.x = unit(0.10,"cm"),
panel.spacing.y = unit(0.05,"cm"),
# axis.ticks.y= element_blank()
axis.ticks=element_blank(),
axis.text=element_text(colour="black"),
axis.text.x = element_blank(),
axis.text.y = element_text(size = 12))
#-------------------------------------------------------------------------------#
#-------------------------------------------------------------------------------#
# Shiny Application
ui <- fluidPage(
titlePanel(h1("SP+ Citation Application", align = "right")),
sidebarLayout(
sidebarPanel(width = 3,
dateRangeInput("dates", label = "Date range", start = Sys.Date()-7, end = Sys.Date()-7, min = min(Reformat_Date), max = max(Reformat_Date)),
pickerInput("Location",label = "Location", choices = rownames(Location_Options),
multiple = TRUE, selected = rownames(Location_Options)[], options = list(`actions-box` = TRUE,`none-selected-text` = "No Locations", `selected-text-format` = "count > 3",
`count-selected-text` = "ALL", `live-search` = TRUE
)),
pickerInput('Violation', 'Violation', choices = rownames(Violation_Options),
multiple = TRUE, selected = rownames(Violation_Options)[],options = list(`actions-box` = TRUE,`none-selected-text` = "No Locations", `selected-text-format` = "count > 3",
`count-selected-text` = "ALL", `live-search` = TRUE
)),
pickerInput('Officer', 'Officer', choices = rownames(Officer_Options),
multiple = TRUE,selected = rownames(Officer_Options)[], options = list(`actions-box` = TRUE,`none-selected-text` = "No Locations", `selected-text-format` = "count > 3",
`count-selected-text` = "ALL", `live-search` = TRUE))
),
mainPanel(width = 9,
tabsetPanel(tabPanel("Time of Day",textOutput("TOTAL"), align = "right",plotOutput("TOD")),
tabPanel("Data Table", dataTableOutput("Table")),
#tabPanel("WOOP", dataTableOutput("Tester")),
tabPanel("Breakdown", radioGroupButtons(
inputId = "LVO_Filter",
label = "",
choices = c("Location","Violation","Officer"),justified = TRUE),
plotOutput("LocationBD", width = "100%", height = "700"))))
))
server <- function(input, output, session) {
#User subsets dataframe
NEW_df <- reactive({
m <- Clean_Complete %>% select(everything()) %>% filter(Clean_Complete$Reformat_Date >= input$dates[1] & Clean_Complete$Reformat_Date <= input$dates[2],Clean_Complete$Location %in% input$Location, Clean_Complete$Violation %in% input$Violation, Clean_Complete$Officer %in% input$Officer)
})
#Create Reactive Maximum Value for Y-Axis on Time of Day Plot
upper_y_value <- reactive({
Count_Hour_of_Day <- NEW_df() %>% count(Hour_of_Day)
Hour_of_Day_calc <- max(Count_Hour_of_Day$n) + sd(Count_Hour_of_Day$n / 4) + 5
print(Hour_of_Day_calc)
})
#Display Total Count of Citations
Total_Citations <- reactive({
numb <- nrow(NEW_df())
numb <- as.character(numb)
paste("Number of Parking Citations Issued by Hour (",numb,")")
})
#Produce Time of Day Plot
output$TOD <- renderPlot({
ggplot(NEW_df(), aes(x = Hour_of_Day)) +
geom_bar(color = barlines, fill = barfill, width = 1,position = position_nudge(x = 0.5)) +
scale_x_discrete(drop=F) +
geom_text(stat='count', aes(label=..count..),nudge_x = 0.5,vjust = -0.5, size = 5) +
scale_y_continuous(name = "Citations Issued",expand = c(0,0)) +
ggtitle("Number of Parking Citations Issued by Hour") +
xlab("Time of Day (Hour)") +
hw + expand_limits(y=c(0,upper_y_value()))
})
#Produce Data Table
output$Table <- renderDataTable({ NEW_df()[c(1:5,8)]
})
#Location, Violation, Officer (LVO) Breakdown
spitout <- reactive({
LocCal <- NEW_df() %>% group_by_(input$LVO_Filter) %>% summarize(count = n()) %>% arrange(desc(count))
LocCal <- as.data.frame(LocCal)
if(nrow(LocCal) > 29){
subLocCal <- LocCal[(1:29),]
subLocCal <- as.data.frame(subLocCal)
} else {
subLocCal <- LocCal[]
subLocCal <- as.data.frame(subLocCal)
}
})
#Create Reactive Maximum Value for Y-Axis on Breakdown Plots
upper_y_value_breakdown <- reactive({ 1.25 * max(spitout()$count) })
#Function for Breakdown Plots
produce_breakdown_fx <- function(indata){
df <- indata
ggplot(df, aes(x = reorder(df[,1],df[,2]), y = df[,2])) +
geom_bar(color = barlines, fill = barfill_2, width = 1, stat = "identity") +
scale_x_discrete(drop=F) +
scale_y_continuous(name = "Number of Citations",expand = c(0,0)) +
geom_text(stat= 'identity', aes(label = df[,2]), size = 5, nudge_y = upper_y_value_breakdown() * 0.03) +
ggtitle(paste(" \n Count by", input$LVO_Filter)) +
xlab("") +
hy + expand_limits(y=c(0,upper_y_value_breakdown())) + coord_flip()
}
# Produce Breakdown Plots
output$LocationBD <- renderPlot({
produce_breakdown_fx(spitout())
})
#Citation Title
Total_Citations <- reactive({
numb <- nrow(NEW_df())
numb <- as.character(numb)
paste("(Total Count: ",numb,")")
})
output$TOTAL <- renderText({Total_Citations()})
}
# Run the application
shinyApp(ui = ui, server = server)