Question

简单，问题，但没有答案对我有用。我google了很多，但仍在苦苦挣扎。

我正在尝试按日期过滤传单地图上的事件。

# Install packages
library(shiny)
library(shinydashboard)
library(tidyverse)
library(leaflet)
library(shinythemes)
library(knitr)
library(kableExtra)
library(RColorBrewer)
library(Hmisc)


# Read the initial file
incidents <- read.csv("Crime Incidents in 2017.csv", header = TRUE, 
stringsAsFactors = FALSE)

# Clean date format
incidents$Report.date <- as.Date(incidents$Report.date, format = "%Y-%m-%d")
class(incidents$Report.date)

# Define function for legend
addLegendCustom <- function(map, colors, labels, sizes, opacity = 0.5, ...){
colorAdditions <- paste0(colors, "; width:", sizes, "px; height:", sizes, 
"px")
labelAdditions <- paste0("<div style='display: inline-block;height: ", 
                       sizes, "px;margin-top: 4px;line-height: ", sizes, 
"px;'>", labels, "</div>")

return(addLegend(map, colors = colorAdditions, labels = labelAdditions, 
opacity = opacity, ...))
}

# User interface
ui <- fluidPage(theme = shinytheme("united"),
            titlePanel(HTML("<h1><center><font size=14> Crimes in 
Washington, DC (2017) </font></center></h1>")),
            # titlePanel("Crimes in Washington, DC (2017)", align = 
"center"), 
            fluidRow(column(4, align="center", 
                            selectInput("offenceInput", "Type of Offence",
                                        choices = sort(unique(incidents$Offense)),
                                        selected = sort(unique(incidents$Offense)),
                                        multiple = TRUE),
                            selectInput("methodInput", "Method of Offence",
                                        choices = sort(unique(incidents$Method)),
                                        selected = sort(unique(incidents$Method)),
                                        multiple = TRUE),
                            selectInput("shiftInput", "Police Shift",
                                        choices = sort(unique(incidents$Shift)),
                                        selected = sort(unique(incidents$Shift)),
                                        multiple = TRUE),
                            selectInput('background', 'Background',
                                        choices = providers,
                                        multiple = FALSE,
                                        selected = 'Stamen.TonerLite'),
                            dateRangeInput('daterangeInput',
                                             label = 'Date',
                                             start = as.Date('2017-01-01') , end = as.Date('2017-12-31')
                              )
            ),


            column(8,
                   leafletOutput(outputId = 'map', height = 600, width = 800),

                   column(12,
                          dataTableOutput('selected_date')
            )
            )

)) #)

# SERVER
server <- function(input, output, session) {  

# Filter the data based on inputs
filtered_data <- reactive({
selected_offence <- input$offenceInput
selected_method <- input$methodInput
selected_shift <- input$shiftInput
selected_date <- input$daterangeInput

out <- incidents

# Offense filtering

if(!is.null(selected_offence)){
  if(!all(selected_offence == '')){
    message('Keeping the following offences:')
    message(paste0('---', selected_offence, '\n', collapse = ''))
    out <- out %>%
      filter(Offense %in% selected_offence)
  }

}

# Method filtering filtering
if(!is.null(selected_method)){
  if(!all(selected_method == '')){
    message('Keeping the following methods:')
    message(paste0('---', selected_method, '\n', collapse = ''))
    out <- out %>%
      filter(Method %in% selected_method)
  }
}

# Shift filtering 
if(!is.null(selected_shift)){
  if(!all(selected_shift == '')){
    message('Keeping the following shifts:')
    message(paste0('---', selected_shift, '\n', collapse = ''))
    out <- out %>%
      filter(Shift %in% selected_shift)
  }
}

# Date filtering 
if(!is.null(selected_date)){
if(!all(selected_date == '')){
message('Keeping the following dates:')
message(paste0('---', selected_date, '\n', collapse = ''))
out <- out %>%
filter(Report.date %in% selected_date)
}
}

return(out)
})

output$map <- renderLeaflet({


# Get the filtered data first
df <- filtered_data()

# If there is any data, carry on
if(nrow(df) > 0){

  l <- 
    leaflet(data = df) %>% 
    addProviderTiles(input$background) %>% 
    setView(-77.0369, 38.9072, zoom = 12)

  message(nrow(df), ' crimes filtered.')

  # Define a color vector
  color_vector <- colorRampPalette(RColorBrewer::brewer.pal(n = 9, name = 'Paired'))(length(unique(df$Offense)))
  color_labels <- sort(unique(df$Offense))
  pal <- colorFactor(
    color_vector,
    domain = color_labels)

  l <- l %>%
    addCircles(lng = df$Lon, lat = df$Lat, weight = 1,
               popup = paste0(df$Offense, ' at ', df$Block),
               color = ~pal(df$Offense),
               radius = 20, opacity = 0.9) %>%
    addLegendCustom(colors = color_vector, 
                    labels = color_labels, sizes = rep(20, length(color_vector)),
                    position = 'bottomright',
                    opacity = 0.9,
                    title = 'Offense type')

} else {
  message('No crimes with current filter settings.')
  l <- l <- 
    leaflet() %>% 
    addProviderTiles(input$background) %>% 
    setView(-77.0369, 38.9072, zoom = 12)
}
return(l)
})


}

# Run the application 
shinyApp(ui = ui, server = server)

结果我收到了这个常见错误

Warning: Error in charToDate: character string is not in a standard unambiguous format

我的假设是我需要将自己的约会作为角色，但到目前为止已经多次努力失败了。

非常感谢

数据在这里dropbox

奥雷克

Answer 1

您只需要为第二个 selected_date 添加as.character()，如下所示。由于selected_date是日期格式，selected_date ==＆＃39;＆＃39;扔你错误信息。（如果你运行as.Date('2017-01-01') == ""，你将得到相同的错误信息。）

# Date filtering 
 if(!is.null(selected_date)){
   if(!all(as.character(selected_date) == '')){
     message('Keeping the following dates:')
     message(paste0('---', selected_date, '\n', collapse = ''))
     out <- out %>%
       filter(Report.date %in% selected_date)
   }
 }

很酷的应用程序顺便说一句！

无法按照日期过滤

1 个答案: