Simple, question, but non of the answers work for me. I googled a lot, but still struggling.
I am trying to filter events on a leaflet map by date.
# 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)
As a result I receive this common error
Warning: Error in charToDate: character string is not in a standard unambiguous format
My assumption that I need to make my date as character, but multiple efforts failed so far.
Much appreciated
Data is here dropbox
Oleksiy
you will just need to add as.character()
for the second selected_date as below. Since the selected_date is date format, selected_date=='' is throwing you the error message. (if you run as.Date('2017-01-01') == ""
, you will get the same error msg.)
# 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)
}
}
Cool app btw!
The technical post webpages of this site follow the CC BY-SA 4.0 protocol. If you need to reprint, please indicate the site URL or the original address.Any question please contact:yoyou2525@163.com.