我最近创建了一个Shiny App,用于跟踪一天中发布的停车引用的数量,并按小时细分,并按时间范围,位置,违规和官员进行过滤。当我在本地运行该应用程序时,它似乎运行良好:
# 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"), exclude = NA)
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.AM" = "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()[1:5]
})
#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)
当我将应用程序上传到我的Shinyapps.io帐户(https://cypher-trial.shinyapps.io/Citation-Demo-App/)时,一切似乎都工作正常,但“时间图表”将“时间(小时)”中发布为NA的所有引用可视化“轴。
shinyapps.io Incorrect Plot Output Picture
日志表明问题与包含隐式NA的因素'Hour_of_Day'有关:
2019-02-26T23:43:21.998404+00:00 shinyapps[741215]: Warning: Factor `Hour_of_Day` contains implicit NA, consider using `forcats::fct_explicit_na`
2019-02-26T23:43:21.999019+00:00 shinyapps[741215]: [1] NA
我尝试使用推荐的forcats::fct_explicit_na
解决方案,但我的“每日时段”图保持不变。我不确定是什么原因导致“ Hour_of_Day”行为异常,只会导致不适用,尤其是考虑到本地的Shiny App似乎运行得很好。任何有关如何解决该问题的建议将不胜感激!
更新:我解决了提示“因素Hour_of_Day
包含隐含NA”警告的问题,但显然,该警告与我的“ Hour_of_Day”因子成为每一行的NA无关。该应用程序运行时,日志不再显示任何错误或警告,因此,如何解决问题我什至迷失了。
已解决::问题已发现,该应用现已修复! 在以下格式语句中,我的代码在“ H”之后还有一个附加的“%”。
Hours <- format(Q, "%H%:%M:%S")