Создание блестящего приложения карты с использованием реактивного ввода даты в листовке

#r #shiny #leaflet

Вопрос:

Я создал блестящее приложение, в котором пользователь может выбирать из диапазона дат, чтобы показывать преступления, совершенные в Чикаго, по долготе и широте.

Проблема, с которой я сталкиваюсь, заключается в том, чтобы сделать dateRangeInput реактивным в выводе листовки. Я просмотрел множество различных вариантов и обнаружил, что они работают лучше всего, но проблемы, с которыми я сталкиваюсь, следующие:

  1. Карта генерируется с помощью маркеров, но не реагирует (при комментировании маркеров очистки())
  2. Карта генерируется без маркеров, поэтому я даже не могу сказать, является ли она реактивной или нет (при использовании маркеров очистки())

Я пробовал оба подхода, используя 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)