当我将本地有光泽的应用程序上载到shinyapps.io时,为什么我的因子行(Hour_of_Day)变为NA?

时间:2019-02-27 00:09:43

标签: r shiny shinyapps

我最近创建了一个Shiny App,用于跟踪一天中发布的停车引用的数量,并按小时细分,并按时间范围,位置,违规和官员进行过滤。当我在本地运行该应用程序时,它似乎运行良好:

Correct Plot Output Picture

Dataset Used

# 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")

0 个答案:

没有答案