r - 如何创建闪亮的滑块应用程序以在我创建的地图上查看我的数据？

Question

我使用下面的数据框在传单中创建了一个地图，使用下面的代码。但是，输出地图仅显示数据中最后一个时间戳在每个位置的数据。输出映射如下代码。

如何使用闪亮的应用程序在具有滑块选项的“日期”列的范围内显示此数据，而不是使用仅显示最新时间戳数据的传单的地图！

test_map <- leaflet(width="100%") %>%
  setView(lng=-123.2504, lat= 49.2652, zoom=15) %>%
  addProviderTiles("Esri.WorldStreetMap")

test_map %>%
  addCircles(
    data=AQ_df,
    lng = ~Longitude,
    lat = ~Latitude,
    radius = 30,
    color = 'black',
    fillColor = ~pal(severity),
    fillOpacity = 1,
    weight=1,
    popup = paste0("<strong>ID: </strong>", AQ_df$RAMP_label, "</br>",
                   "<strong>Location: </strong>", AQ_df$RAMP_desc, "</br>",
                   "<strong>PM2.5 (ug/m3): </strong>", AQ_df$PM_RAMP, "</br>",
                   "<strong>CO (ppb): </strong>", AQ_df$CO_RAMP, "</br>",
                   "<strong>NO (ppb): </strong>", AQ_df$NO_RAMP, "</br>",
                   "<strong>NO2 (ppb): </strong>", AQ_df$NO2_RAMP, "</br>",
                   "<strong>O3 (ppb): </strong>", AQ_df$O3_RAMP, "</br>",
                   #"<strong>CO2 (ppm): </strong>", AQ_df$CO2_RAMP, "</br>",
                   #"<strong>Temperature (C): </strong>", AQ_df$T_RAMP, "</br>",
                   #"<strong>Relative Humidity (%): </strong>", AQ_df$RH_RAMP, "</br>",
                   "<strong>Date: </strong>", AQ_df$date)
  ) %>%
  addLegend(
    position = c("topright"),
    pal=pal,
    values=AQ_df$severity,
    title="<strong>PM2.5 (ug/m3)</strong>") 

标签： rshinyleaflet

Answer 1

library(tidyverse)
library(leaflet)
library(lubridate)
library(shiny)

test_map <- leaflet(width = "100%") %>%
  setView(lng = -123.2504, lat = 49.2652, zoom = 15) %>%
  addProviderTiles("Esri.WorldStreetMap")

data <- tribble(
  ~date, ~color, ~Longitude, ~Latitude,
  "2021-09-21", "blue", -123.2464, 49.2675,
  "2021-09-20", "red", -123.2464, 49.2675,
  "2021-09-21", "black", -123.248, 49.2675
) %>%
  mutate(date = date %>% parse_date_time("%Y-%m-%d"))

ui <- shinyUI(pageWithSidebar(
  headerPanel("Hello Shiny Leaflet with Date range!"),
  sidebarPanel(
    dateRangeInput(
      "range",
      "Date range",
      start  = "2021-09-10",
      end    = "2021-09-30"
    )
  ),
  mainPanel(
    leafletOutput("map")
  )
))

server <- shinyServer(function(input, output) {
  filtered_data <- reactive({
    data %>% filter(date > input$range[1] & date < input$range[2])
  })

  output$map <- renderLeaflet({
    test_map %>%
      addCircles(
        data = filtered_data(),
        lng = ~Longitude,
        lat = ~Latitude,
        radius = 30,
        color = "black",
        fillOpacity = 1,
        weight = 1,
        fillColor = filtered_data()$color
      )
  })
})

shinyApp(ui, server)