#r #shiny #leaflet
Вопрос:
Я создал блестящее приложение, в котором пользователь может выбирать из диапазона дат, чтобы показывать преступления, совершенные в Чикаго, по долготе и широте.
Проблема, с которой я сталкиваюсь, заключается в том, чтобы сделать dateRangeInput реактивным в выводе листовки. Я просмотрел множество различных вариантов и обнаружил, что они работают лучше всего, но проблемы, с которыми я сталкиваюсь, следующие:
- Карта генерируется с помощью маркеров, но не реагирует (при комментировании маркеров очистки())
- Карта генерируется без маркеров, поэтому я даже не могу сказать, является ли она реактивной или нет (при использовании маркеров очистки())
Я пробовал оба подхода, используя observe() и observeEvent().
Пожалуйста, помогите… чего мне не хватает.
Данные можно найти по адресу https://data.cityofchicago.org/Public-Safety/Crimes-2001-to-Present/ijzp-q8t2 **** Интересует диапазон дат с 01/01/20 по 09/30/20…. файл, на который ссылается в данных
crimes.df <- read.csv("Crimes_2020.csv", stringsAsFactors = TRUE)
#Seprating Date and Time into multiple columns
dup_crimes.df$datetime <- as.POSIXct(dup_crimes.df$Date, format = "%m/%d/%Y %H:%M")
dup2_crimes.df <- transform(dup_crimes.df, time = format(dup_crimes.df$datetime, "%T"),
date = format(dup_crimes.df$datetime, "%m/%d/%Y"))
class(dup2_crimes.df$date)
dup2_crimes.df$Month <- as.numeric(format(as.Date(dup2_crimes.df$date), format = "%y"))
dup2_crimes.df$Month.Name <- month.abb[dup2_crimes.df$Month]
#Filter out locations NOT related to Chicago
dup3_crimes.df <- filter(dup2_crimes.df, dup2_crimes.df$Latitude >= 41)
unique(dup3_crimes.df$Primary.Type)
ui <- fluidPage(
titlePanel("2020 Crimes in Chicago"),
tabsetPanel(type = "tabs",
tabPanel("Map of Location of crimes by date",
dateRangeInput(inputId = "date",
label = "Date",
start = '2020-02-25',
end = '2020-07-04',
min = '2020-01-01',
max = '2020-09-30'
),
leafletOutput("Map"))
)
)
server <- function(input,output){
datefileter1 <- reactive({
dup3_crimes.df[
dup3_crimes.df$date >= input$date[1] amp;
dup3_crimes.df$date <= input$date[2],]
})
#https://www.youtube.com/watch?v=G5BDubIyQZY
#Static Map
output$Map <- renderLeaflet({
leaflet(data = dup3_crimes.df) %>%
addTiles() %>%
addCircleMarkers(lng = ~Longitude, lat = ~Latitude)
})
#Put Dynamic Content
# observe(leafletProxy("Map", data = datefileter1()) %>%
# clearMarkers() %>%
# addCircleMarkers(lng = ~Longitude, lat = ~Latitude)
# )
observeEvent(input$date,
leafletProxy("Map", data = datefileter1()) %>%
clearMarkers() %>%
addCircleMarkers(lng = ~Longitude, lat = ~Latitude)
)
# observe({
#
# leafletProxy("Map", data = datefilter()) %>%
# clearShapes() %>%
# addCircles(radius = ~10^mag/10, weight = 1, color = "#777777",
# fillColor = ~pal(mag), fillOpacity = 0.7, popup = ~paste(mag)
# )
# })
#
}
#Run Shiny App
shinyApp(ui = ui , server =server)
—->>> С четкими маркерами()
—->>> Без маркеров очистки() — показывает все местоположения и НЕ реагирует (намеренно выбрано 7/4/20)
Комментарии:
1. Можете ли вы предоставить нам данные, чтобы сделать этот пост воспроизводимым и проверить наши ответы? Отредактируйте свой пост, чтобы включить вывод
dput(crimes.df)
.
Ответ №1:
Попробуйте это, это должно сработать. Вы можете включить реактивный df в простой вызов листовки:
ui <- fluidPage(
titlePanel("2020 Crimes in Chicago"),
tabsetPanel(type = "tabs",
tabPanel("Map of Location of crimes by date",
dateRangeInput(inputId = "date",
label = "Date",
start = '2020-02-25',
end = '2020-07-04',
min = '2020-01-01',
max = '2020-09-30'
),
leafletOutput("Map"),
tableOutput("tab"))
)
)
server <- function(input,output){
datefileter1 <- reactive({
dup3_crimes.df[
dup3_crimes.df$date >= input$date[1] amp;
dup3_crimes.df$date <= input$date[2],]
})
output$tab <- renderTable(datefileter1())
output$Map <- renderLeaflet({
leaflet(data = datefileter1()) %>%
addTiles() %>%
addCircleMarkers(lng = ~Longitude, lat = ~Latitude)
})
}
#Run Shiny App
shinyApp(ui = ui , server =server)